Comparaison de 2 feuilles et ajout à conditions
Bonjour à tous,
Je viens vous demander de l'aide car j'ai un petit soucis dans l'exécution de ma macro.
Je cherche à comparer 2 feuilles comportant des données similaires. Si la cellule recherchée n'est pas trouvé dans la feuille "analyse programme", alors on l'ajoute à la suite. Si jamais elle est trouvée et que l'une des cellules adjacentes à celle trouvée ne correspond pas aux cellules adjacentes à la cellule testée, alors on l'ajoute à la suite. J'ai pu trouvé de l'info sur le find dans le cas ou ce n'est pas trouvé, ce qui semble me poser problèmes ici. J'ai l'impression de ne pas pouvoir effectuer une opération d'ajout dans le cas ou le find est négatif. Avez-vous une solution à me proposer ?
Merci de votre aide.
EDIT: Le programme semble ne pas aimer le Find(). Address.Row Je chercher à récupérer la ligne car le résultat ne peut étre que dans la premiere colonne.
Sub MAJAUTO()
Dim INBDN As Worksheet
Dim AP As Worksheet
Dim PlageBDN As Range
Dim PlageAP As Range
Dim derl As Integer
Dim Cell As Range
Dim test As Range
Dim resultat As Range
INBDN = Worksheets("Base de données")
AP = Worksheets("Analyse Programmes")
With INBDN: Set PlageBDN = .Range(.Cells(2, 1), .Cells(.Rows.Count, 1).End(xlUp)): End With
With AP: Set PlageAP = .Range(.Cells(10, 1), .Cells(.Rows.Count, 7).End(xlUp)): End With
derl = Worksheets("Analyse Programmes").UsedRange.SpecialCells(xlCellTypeLastCell).Row + 1
For Each Cell In PlageBDN
'On regarde si la cellule considérée (Item Number) est déja présent dans l'analyse des programmes existants
Set test = PlageAP.Find(Cell)
If test Is Nothing Then 'Non
'Si elle n'est pas présente alors on vient coller les 4 cellules dans la feuille "Analyse Programmes"
' à la suite des données déja présentes
Worksheets("Analyse Programmes").Cells(derl, 1) = Cell
Worksheets("Analyse Programmes").Cells(derl, 2) = Cell.Offset(, 2)
Worksheets("Analyse Programmes").Cells(derl, 3) = Cell.Offset(, 3)
Worksheets("Analyse Programmes").Cells(derl, 7) = Cell.Offset(, 1)
derl = derl + 1
End If
If Not test Is Nothing Then 'Non+Non=Oui
resultat = PlageAP.Cells.Find(Cell).Address.Row
'Comment récupérer la position de la cellule ?
'Ici la cellule recherchée est dans la page, il faut alors comparer les TAPE et les REV.
If resultat.Offset(, 1) <> Cell.Offset(, 2) Or resultat.Offset(, 2) <> Cell.Offset(, 3) Then
AP(derl, 1) = Cell
AP(derl, 2) = Cell.Offset(, 2)
AP(derl, 3) = Cell.Offset(, 3)
AP(derl, 7) = Cell.Offset(, 1)
derl = derl + 1
End If
End If
Next Cell
End Sub
Salut CharlesIrca,
sans fichier réel, comme on dit dans ce cas-là : à tester et, sans doute, à adapter!
'
Dim INBDN, AP As Worksheet
Dim tTab1, tTab2
Dim iRow As Integer
'
Set INBDN = Worksheets("Base de données")
Set AP = Worksheets("Analyse Programmes")
'
With INBDN
tTab1 = .Range("A2:D" & .Cells(Rows.Count, 1).End(xlUp).Row)
End With
'
Application.ScreenUpdating = False
'
With AP
For x = 1 To UBound(tTab1, 1)
iRow = .UsedRange.SpecialCells(xlCellTypeLastCell).Row + 1
tTab2 = .Range("A1:I" & iRow)
iOK = 0
For y = 1 To UBound(tTab2, 1)
For Z = 1 To UBound(tTab2, 2) - 2
If tTab1(x, 1) = tTab2(y, Z) Then
iOK = 1 'Oui
Exit For
End If
If Z = 7 Then Exit For
Next
iOK = IIf(iOK = 1 And tTab2(y, Z + 1) = tTab1(x, 3) And tTab2(y, Z + 2) = tTab1(x, 4), 1, 0)
If iOK = 0 Then
.Cells(iRow, 1) = tTab1(x, 1)
.Cells(iRow, 2) = tTab1(x, 3)
.Cells(iRow, 3) = tTab1(x, 4)
.Cells(iRow, 7) = tTab1(x, 2)
End If
Next
Next
End With
'
Application.ScreenUpdating = True
'
A+
Merci curulis57
Je suis un peu mêlé dans ton code et je ne pense pas bien comprendre les fonctions que tu utilises. Peux tu écrire quelques commentaires la dessus ?
De plus, j'ai fais un test avec le fichier que tu m'as donné, je te le retourne. Pour faire simple, la donnée de la colonne B ne doit pas être un critère, mais les données des colonnes A,C,D sont des critères. Si A,C et D sont dans la feuille "Analyse Programme" alors on colle la colonne B de "Base de données" dans la colonne G de "Analyse Programmes". Comme je n'arrive pas à comprendre ton code je ne vois pas ou je peux modifier cela ...
Autre question, comme on active ta macro ? Je ne connais pas l'utilisation de ton bouton rouge ... J'ai du créer mon Click Bouton ...
Merci pour ton aide, c'est super
Salut CharlesIrca,
j'ai l'habitude de traiter de gros volumes (ou supposés tels) en 'capturant' ces données dans des tableaux (tTab1 et tTab2) pour accélérer le traitement en mémoire.
Pour être cohérent, je devrais même aller plus loin encore avec ton fichier mais bon...
Cela dit, plusieurs choses à mettre au point:
- EDIT: Le programme semble ne pas aimer le Find(). Address.Row Je chercher à récupérer la ligne car le résultat ne peut être que dans la première colonne
or tu définis la zone de recherche sur plusieurs colonnes...
- Set PlageAP = .Range(.Cells(10, 1), .Cells(.Rows.Count, 7).End(xlUp))
- Set test = PlageAP.Find(Cell)
- Tes critères pour copie =
If resultat.Offset(, 1) <> Cell.Offset(, 2) Or resultat.Offset(, 2) <> Cell.Offset(, 3) Then … copie
=si Résultat+1 <> ColonneC OU si Résultat+2 <> Colonne4, on copie -> = donc si les deux pareils, pas de copie
= -> iOK = IIf(iOK = 1 And tTab2(y, Z + 1) = tTab1(x, 3) And tTab2(y, Z + 2) = tTab1(x, 4), 1, 0)
If iOK = 0 Then... copie
- or tu dis maintenant
Si A,C et D sont dans la feuille "Analyse Programme" alors on colle la colonne B
Ce n'est plus pareil!
On va déjà essayer d'accorder nos violons sur ça! D'ac?
A+
On peut clore le sujet, j'ai fais un processus un peu différent, voici comment:
J'ai crée une colonne ou je compare (en concaténant) mes données d'entrées vers ma base de données de fichiers traité. Si jamais, il ne les trouve pas ( c'est à dire il me retourne #N/A) dans ce cas, je mets la variable à 0:
=SI(ESTNA(RECHERCHEV([@[Item Number]]&[@[No Tape]]&[@REV];'Analyse Programmes'!H:H;1;FAUX))=FAUX;0;1)
ENsuite, j'utilise la macro suivante:
Sub TOTO()
Dim CPT As Integer
Dim CPT1 As Integer
CPT = 0
10
If Range("A2").Offset(CPT, 0) = "" Then
Else
If Range("A2").Offset(CPT, 4) = 1 Then
Item_Number = Range("A2").Offset(CPT, 0)
Seq = Range("A2").Offset(CPT, 1)
No_Tape = Range("A2").Offset(CPT, 2)
REV = Range("A2").Offset(CPT, 3)
CPT1 = 0
20
If Sheets("Analyse Programmes").Range("A9").Offset(CPT1, 0) = "" Then
Sheets("Analyse Programmes").Range("A9").Offset(CPT1, 0) = Item_Number
Sheets("Analyse Programmes").Range("A9").Offset(CPT1, 1) = No_Tape
Sheets("Analyse Programmes").Range("A9").Offset(CPT1, 2) = REV
Sheets("Analyse Programmes").Range("A9").Offset(CPT1, 6) = Seq
Sheets("Analyse Programmes").Range("A9").Offset(CPT1, 7).FormulaR1C1 = "=RC[-7]&RC[-6]&RC[-5]"
Sheets("Analyse Programmes").Range("A9").Offset(CPT1, 4).FormulaR1C1 = "=COUNTIF(RC[4]:RC[20],""*"")"
CPT = CPT + 1
GoTo 10
Else
CPT1 = CPT1 + 1
GoTo 20
End If
End If
CPT = CPT + 1
GoTo 10
End If
End Sub
Merci pour ton aide curulis57