Fonction COUNTIF
Résolu
camcam1404
Messages postés
68
Statut
Membre
-
camcam1404 Messages postés 68 Statut Membre -
camcam1404 Messages postés 68 Statut Membre -
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.
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)
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)
4 réponses
-
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...
-
-
Merci ! Voilà il est là le fichier: https://www.cjoint.com/c/GBiqOQnaQaM
-
-
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...
-
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...
-
-
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
-
-
-
-
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 -
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 !
-
-
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...
-
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 :)- 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
-
