Sujet Précédent Sujet Suivant

Fonction COUNTIF

Résolu/Fermé
camcam1404 Messages postés 64 Date d'inscription mardi 13 décembre 2016 Statut Membre Dernière intervention 9 septembre 2019 - Modifié par pijaku le 9/02/2017 à 08:17
camcam1404 Messages postés 64 Date d'inscription mardi 13 décembre 2016 Statut Membre Dernière intervention 9 septembre 2019 - 17 févr. 2017 à 09:40
Bonjour,

J'ai besoin d'aide pour une code qui est peut-être un peu compliqué.

J'ai plusieurs feuilles de calcul:
Un feuille appelé "REF"
D'autres feuilles appelés "RES_XX.XX.XXXX" où XX.XX.XXXX correspond à une date que l'on peut retrouver dans la colonne A de la feuille nommé "REF"

Si un feuille "RES_XX.XX.XXXX" contient la date inscrit en colonne A de la feuille appelé "REF", je veux savoir si le contenu de la colonne B de la feuille concernée "RES_XX.XX.XXXX" est contenu dans la colonne C de la feuille nommé "REF". Si oui la colonne C de la feuille "RES_XX.XX.XXXX" contient un 1, si non un 0.
(J’espère avoir bien expliqué le code que je souhaite mettre en place).

Voilà le code que j’ai écrit. Il me semble que la fonction COUNTIF est adapté À ma situation, cependant son utlisation n’est pas très clair pour moi. 


Sub pairing()

Dim f As Worksheet
Dim e As Worksheet
Dim lastrow As Long
Dim i As Long

For Each f In ActiveWorkbook.Worksheets

If UCase(f.Name) Like "*REF*" Then
       e = f.Name
       End If

If UCase(f.Name) Like "*RES_*" Then 

lastrow = f.Range("A" & Application.Rows.Count).End(xlUp).Row

For i = 2 To lastrow

While f.Range("A:A") Like f.Name Then 

If   ActiveCell.FormulaR1C1 = "=COUNTIF(RES_310117!C[-3],REF!RC[-2])" Then                                      
                        Colums(i,3)=1 
                Else   Colums(i,3)=0
                 End if

Wend
         Next i

End If

Next f

End Sub



ActiveCell.FormulaR1C1 = "=COUNTIF(RES_310117!C[-3],REF!RC[-2])" (C´est ce que j'obtient avec l'enregistreur de macro mais je vois pas trop comment adapté cette formule a mon cas)
J´ai essayé ceci sans succés: countif(f.Cells(i,2),e.Cells (i,3)
A voir également:

4 réponses

Réponse 1 / 4
ThauTheme Messages postés 1442 Date d'inscription mardi 21 octobre 2014 Statut Membre Dernière intervention 29 juillet 2022 160
8 févr. 2017 à 11:23
Bonjour Camcam, bonjour le forum,

Les explications sont claires ! Mais un petit fichier exemple viendrait illuminer encore plus cette clarté (obscure) car même ton code est confus pour moi...
0
camcam1404 Messages postés 64 Date d'inscription mardi 13 décembre 2016 Statut Membre Dernière intervention 9 septembre 2019
8 févr. 2017 à 11:45
Comment joindre un fichier À la conversation ?
0
ThauTheme Messages postés 1442 Date d'inscription mardi 21 octobre 2014 Statut Membre Dernière intervention 29 juillet 2022 160 > camcam1404 Messages postés 64 Date d'inscription mardi 13 décembre 2016 Statut Membre Dernière intervention 9 septembre 2019
8 févr. 2017 à 12:05
Re,

Par exemple : https://www.cjoint.com/
mais il y a en plein d'autres...
0
camcam1404 Messages postés 64 Date d'inscription mardi 13 décembre 2016 Statut Membre Dernière intervention 9 septembre 2019
8 févr. 2017 à 17:41
Merci ! Voilà il est là le fichier: https://www.cjoint.com/c/GBiqOQnaQaM
0
Réponse 2 / 4
ThauTheme Messages postés 1442 Date d'inscription mardi 21 octobre 2014 Statut Membre Dernière intervention 29 juillet 2022 160
8 févr. 2017 à 23:03
Re,

Le fichier c'est bien mais tes explications sont toujours confuses pour moi. Pourquoi seules 3 cellules sont colorées de jaunes ?
Pourrais-tu rajouter un onglet dans ton fichier en montrant ce que tu désires avoir après le traitement par la macro. Peut-être réussirai-je à mieux comprendre...
0
camcam1404 Messages postés 64 Date d'inscription mardi 13 décembre 2016 Statut Membre Dernière intervention 9 septembre 2019
9 févr. 2017 à 18:21
Bonsoir,
Voilà ce que je veux obtenir: https://www.cjoint.com/c/GBjrsWnYNev
J'espère que c 'est plus clair maintenant.
J'ai coloré certain cellule de la colonne A dans la feuille REF pour mettre en valeur le changement de date. Les dates correspondent au jour de la création du numéro de série.
Le mesures (j'ai pas donné les valeurs des mesures) sont toujours effectués (feuille RES) le même jour ou le numéro de série a été affecté au produit (feuille REF)

Il faut savoir aussi que plusieurs produit peuvent avoir le même numéro de série uniquement si ils n'ont pas été mesurés à la même date...
0
Réponse 3 / 4
ThauTheme Messages postés 1442 Date d'inscription mardi 21 octobre 2014 Statut Membre Dernière intervention 29 juillet 2022 160
9 févr. 2017 à 21:33
Re,

Essaie comme ça : 

Sub Macro2()
Dim R As Worksheet 'déclare la variable R (onglet REF)
Dim TR As Variant 'déclare la variable TR (Tableau des Références)
Dim O As Worksheet 'déclare la variable O (Onglets)
Dim TD As Variant 'déclare la variable TD (Tableau des Dates)
Dim I As Integer 'déclare la variable I (Incrément)
Dim J As Integer 'déclare la variable J (incrément)

'***************
'les onglet RES_
'***************
Set R = Worksheets("REF") 'définit l'onglet R
TR = R.Range("A1").CurrentRegion 'définit le tableau des références TR
For Each O In Worksheets 'boucle 1 : sur tous les onglets O du classeur
    If O.Name <> R.Name Then 'condition 1 : si le nom de l'onglet O est différent du nom de l'onglet R
        TD = O.Range("A1").CurrentRegion 'définit le tableau des dates TD
        For I = 2 To UBound(TD, 1) 'boucle 2 sur toutes les lignes I du tableau des dates TD (en partant de la seconde)
            For J = 2 To UBound(TR, 1) 'boucle 3 : sur les lignes J du tableau des référence TR (en partant de la seconde)
                'condition 2 :  si la donnée ligne J colonne 1 de TR est égale aux derniers caractères, après le quatrième,
                'du nom de l'onglet O et si les numéros de série sont identiques (en colonne 2 pour TD et en colonne 3 pour TR)
                If TR(J, 1) = Mid(O.Name, 5) And TD(I, 2) = TR(J, 3) Then
                    TD(I, 3) = 1: Exit For 'la donnée ligne I colonne 3 de TD est égale à 1, sort de la boucle 2
                Else 'sinon (condition 2)
                    TD(I, 3) = 0 'la donnée ligne I colonne 3 de TD est égale à 0
                End If 'fin de la condition 2
            Next J 'prochaine ligne de la boucle 2
        Next I 'prochaine ligne de la boucle 1
        'renvoie le tableau TD dans la cellule A1 redimensionnée de l'onglet O
        O.Range("A1").Resize(UBound(TD, 1), UBound(TD, 2)).Value = TD
        Erase TD 'efface le tableau TD
    End If 'fin de la condition 1
Next O 'prochain onglet de la boucle 1

'************
'l'onglet REF
'************
For I = 2 To UBound(TR, 1) 'boucle 1 : sur toutes les lignes I du tableau des références TR (en partant de la seconde)
    With Sheets("RES_" & TR(I, 1)) 'prend en compte l'onglet correspondant à la date de la données ligne I colonne 1 de TR
        TD = .Range("A1").CurrentRegion 'définit la tableau des dates TD
    End With 'fin de la prise en compte l'onglet correspondant à la date de la données ligne I colonne 1 de TR
    For J = 2 To UBound(TD, 1) 'boucle 2 : sur toutes les lignes J du tableau des dates TD (en partant de la seconde)
        'si les numéros de série sont identiques (en colonne 3 pour TR et en colonne 2 pour TD),
        'renvoie 1 dans la cellule ligne I colonne 4 de l'onglet R, va à l'étiquette "suite"
        If TR(I, 3) = TD(J, 2) Then R.Cells(I, 4).Value = 1: GoTo suite
    Next J 'prochaine ligne de la boucle 2
    R.Cells(I, 4).Value = 0 'renvoie 0 dans la cellule ligne I colonne 4 de l'onglet R
suite: 'étiquette
Next I 'prochaien ligne de la boucle 1
End Sub

0
camcam1404 Messages postés 64 Date d'inscription mardi 13 décembre 2016 Statut Membre Dernière intervention 9 septembre 2019
Modifié par camcam1404 le 10/02/2017 à 06:54
Bonjour,

Oula hahah ca c'est du code ! :)
Je vais essayer et je te tiens au courant.

Merci et Bonne journée !
0
camcam1404 Messages postés 64 Date d'inscription mardi 13 décembre 2016 Statut Membre Dernière intervention 9 septembre 2019
10 févr. 2017 à 07:10
J´ai déjà une question !
Pourquoi le Goto est nécessaire dans ce code ? L´étiquette correspond À une ligne ?

(Désolée mais je crois que je vais t'en poser beaucoup des question..^^)
0
camcam1404 Messages postés 64 Date d'inscription mardi 13 décembre 2016 Statut Membre Dernière intervention 9 septembre 2019
15 févr. 2017 à 14:28
Ton code ne fonctionne pas.

Mais j'en ai écrit qui marche presque ! Il me reste un probléme à regler :)
Je te le montrerai quand j'aurai finis.
0
camcam1404 Messages postés 64 Date d'inscription mardi 13 décembre 2016 Statut Membre Dernière intervention 9 septembre 2019
16 févr. 2017 à 10:01
Voilà mon code ! J'ai réussi !
Tu peux me dire ce que tu en penses s'il te plait ? :)
( Je suis débutante et je détestais l'info pendant mes études mais maintenant ca me plait de plus en plus de coder)


Sub pairing()

Dim i As Long
Dim Lastlineref As Long
Dim O As Worksheet

'Sheet REF

Set REF = Worksheets("REF")
Lastlinesar = REF.Range("A1").End(xlDown).Row

For Each O In ActiveWorkbook.Worksheets

If UCase(O.Name) Like "*RES*" Then
For i = 2 To Lastlinesar
If REF.Cells(i, 1) = CDate(Right(O.Name, 10)) Then

SNzusuchen = REF.Cells(i, 3)
Set rangezuabsuchen = O.Columns(2)

Set gefunden = rangezuabsuchen.Cells.Find(what:=SNzusuchen)

If gefunden Is Nothing Then
REF.Cells(i, 4) = 0
Else
REF.Cells(i, 4) = 1
End If

End If
Next i
End If
Next O


'Sheet GEO_

Dim Lastlineres As Long

For Each O In ActiveWorkbook.Worksheets
If UCase(O.Name) Like "*RES*" Then
Lastlineres = O.Range("A2").End(xlDown).Row
For i = 2 To Lastlineres


SNzusuchen = O.Cells(i, 2)
Set rangezuabsuchen = REF.Columns(3)

Set gefunden = rangezuabsuchen.Cells.Find(what:=SNzusuchen)

If gefunden Is Nothing Then
O.Cells(i, 3) = 0
Else
O.Cells(i, 3) = 1
End If

Next i
End If
Next O


End Sub
0
ThauTheme Messages postés 1442 Date d'inscription mardi 21 octobre 2014 Statut Membre Dernière intervention 29 juillet 2022 160 > camcam1404 Messages postés 64 Date d'inscription mardi 13 décembre 2016 Statut Membre Dernière intervention 9 septembre 2019
Modifié par ThauTheme le 16/02/2017 à 11:40
Bonjour Camcam, Pikaju, bonjour le forum,

Tu m'as dit dans ton post précédent que mon code ne fonctionnait pas mais sans aucune indication sur ce qui ne fonctionnait pas ?!... Les tests que j'avais fait sur ton fichier exemple me paraissaient fonctionnels. De plus, la méthode proposée avec des variables tableaux de type Variant était beaucoup plus rapide que de travailler directement dans les cellules. Surtout quand les onglets contiennent beaucoup de lignes...

Juste quelques remarques sur ton code :
• Il est d'usage de déclarer les variables en début de module.
• Tu ne déclares pas toutes les variables. Pourquoi ? Y'en a qui sentent le pâté ?
• la variable Lastlineref ne sert à rien !
• Un code avec identation (et proposé avec les balise de code) est bien plus facile à lire et donc a comprendre.
Ton code en fonction de ces remarques : 
Sub pairing()
Dim REF As Worksheet
Lastlinesar As Long
Dim O As Worksheet
Dim i As Long
Dim SNzusuchen As Variant '(type à redéfinir, dans le doute j'ai mis Variant)
Dim rangezuabsuchen As Range
Dim gefunden As Range
Dim Lastlineres As Long

'Sheet REF
Set REF = Worksheets("REF")
Lastlinesar = REF.Range("A1").End(xlDown).Row
For Each O In ActiveWorkbook.Worksheets
    If UCase(O.Name) Like "*RES*" Then
        For i = 2 To Lastlinesar
            If REF.Cells(i, 1) = CDate(Right(O.Name, 10)) Then
                SNzusuchen = REF.Cells(i, 3)
                Set rangezuabsuchen = O.Columns(2)
                Set gefunden = rangezuabsuchen.Cells.Find(what:=SNzusuchen)
                If gefunden Is Nothing Then
                    REF.Cells(i, 4) = 0
                Else
                    REF.Cells(i, 4) = 1
                End If
            End If
        Next i
    End If
Next O

'Sheet GEO_
For Each O In ActiveWorkbook.Worksheets
    If UCase(O.Name) Like "*RES*" Then
        Lastlineres = O.Range("A2").End(xlDown).Row
        For i = 2 To Lastlineres
            SNzusuchen = O.Cells(i, 2)
            Set rangezuabsuchen = REF.Columns(3)
            Set gefunden = rangezuabsuchen.Cells.Find(what:=SNzusuchen)
            If gefunden Is Nothing Then
                O.Cells(i, 3) = 0
            Else
                O.Cells(i, 3) = 1
            End If
        Next i
    End If
Next O
End Sub


Sinon quoi te dire de plus. L'essentiel c'est que tu sois satisfaite et que ton code fonctionne !
0
Réponse 4 / 4
ThauTheme Messages postés 1442 Date d'inscription mardi 21 octobre 2014 Statut Membre Dernière intervention 29 juillet 2022 160
10 févr. 2017 à 09:08
Re,

Quand les numéros de série sont identiques, on écrit "1" et il n'y a plus nécessité de continuer la boucle. En revanche, si ils ne sont pas identiques, il faut boucler jusqu'à ce que que l'on trouve (ou pas) la correspondance.
Le Goto permet deux choses : sortir de la boucle (un Exit For aurais pu faire l'affaire) et sauter la ligne qui écrit "0" (le Exit For ne pouvait pas faire ça)...

j'appelle étiquette mais je ne suis pas sur que ce soit le terme exact. GoTo permet de faire continuer le code à un endroit précis. On peut utiliser n'importe quel mot (sauf les mots-clé VBA) suivi de deux points (:) pour définir la ligne où repart le code.
On pourrait écrire par exemple : 

If TR(I, 3) = TD(J, 2) Then R.Cells(I, 4).Value = 1: GoTo Camcam
R.Cells(I, 4).Value = 0 'renvoie 0 dans la cellule ligne I colonne 4 de l'onglet R
Camcam: 'étiquette
MsgBox "La Ligne R.Cells(I,4).Value = 0 a été sautée"


J'espère que mes explications sont claires mais si, malgré le code complètement commenté, je dois passer mon temps à expliquer je ne vais pas y arriver. Utilise l'aide VBA avant de poser tes questions...
0
camcam1404 Messages postés 64 Date d'inscription mardi 13 décembre 2016 Statut Membre Dernière intervention 9 septembre 2019
10 févr. 2017 à 13:15
Compris !
Je me suis aussi renseigné de mon cote À ce sujet , je te rassure.
Parmis tout ce que j'ai lu ton explication est la plus claire, encore meci :)
0
pijaku Messages postés 12263 Date d'inscription jeudi 15 mai 2008 Statut Modérateur Dernière intervention 4 janvier 2024 2 744 > camcam1404 Messages postés 64 Date d'inscription mardi 13 décembre 2016 Statut Membre Dernière intervention 9 septembre 2019
Modifié par pijaku le 16/02/2017 à 10:14
Bonjour tous les deux,

Le GoTo, dans ce cas, permet de faire gagner une ligne de code (indiquée ci-dessous).
En effet, une autre solution serait de se servir d'un boolean (ici Test) : 
Dim Test As Boolean
For I = 2 To UBound(TR, 1) 
    Test = False 'Unique ligne de code ajoutée
    With Sheets("RES_" & TR(I, 1)) 
        TD = .Range("A1").CurrentRegion 
    End With
    For J = 2 To UBound(TD, 1) 
       If TR(I, 3) = TD(J, 2) Then Test = True: Exit For 
    Next J 
 'Si Test = True, CInt(Test) * - 1 = 1 Si Test = False, CInt(Test) * - 1 = 0
    R.Cells(I, 4).Value = CInt(Test) * -1 
Next I 
End Sub
0

Discussions similaires

comment contourner la fonction FILTRE
Gabby -
DjiDji59430 -

3 réponses
Message "cette fonction n'est pas disponible actuellement"
daladala -
Marocain -

14 réponses
Comment savoir comment on nous a ajouté sur Snap
Laura -
Mariana -

13 réponses
Fonction MS-DOS non valide
Phoenix78 -
avo9900 -

6 réponses
Excel:récupérer le contenu d'une cellule en fonction d'une autre
tinky31 -
leplot -

1 réponse