XL 2016 Comparer 2 tableaux

fil28 · 10 Novembre 2022

Bonjour tout le monde,

Je suis bloqué sur le problème suivant :
J'ai 3 onglets :
- "Début"
- "Fin"
- "Intermédiaire"

L'onglet "Intermédiaire" = onglet Fin - Début
Dis différemment Intermédiaire doit faire apparaitre les lignes qui sont dans Fin mais qui ne sont pas dans début.

Les 3 caractères dont je me sers pour faire la comparaison sont les colonnes 3, 4 & 7

Sub test()
Dim J, Z, D, F As Integer

Dim Final As Integer
Dim Depart As Integer

Depart = Feuil3.Cells(Rows.Count, 1).End(xlUp).Row
Final = Feuil2.Cells(Rows.Count, 1).End(xlUp).Row

For D = 1 To Depart
Z = 2
For F = 1 To Final

If Feuil3.Cells(D, 3) = Feuil2.Cells(F, 3) And _
Feuil3.Cells(D, 4) = Feuil2.Cells(F, 4) And _
Feuil3.Cells(D, 7) = Feuil2.Cells(F, 7) Then
GoTo Sauter
End If

Next F

Feuil5.Cells(Z, 3).Value = Feuil3.Cells(F, 3).Value
Feuil5.Cells(Z, 4).Value = Feuil3.Cells(F, 4).Value
Feuil5.Cells(Z, 7).Value = Feuil3.Cells(F, 7).Value
Z = Z + 1
Sauter:

Next D

End Sub

J'ai débuté avec ce petit bout de code mais quelque chose ne va pas.

Je boque un peu
Merci d'avance et bon week end à celles et ceux qui font le pont
Philippe

job75 · 10 Novembre 2022

Bonsoir fil28,

Voyez le fichier joint et cette macro dans le code de la feuille "Intermédiaire" :

VB:

Private Sub Worksheet_Activate()
Dim d As Object, tablo, i&, resu(), n&, j%
Set d = CreateObject("Scripting.Dictionary")
d.CompareMode = vbTextCompare 'la casse est ignorée
tablo = Sheets("Début").[A1].CurrentRegion.Resize(, 7) 'matrice, plus rapide
For i = 1 To UBound(tablo)
    d(tablo(i, 4) & tablo(i, 3) & tablo(i, 7)) = ""
Next i
tablo = Sheets("Fin").[A1].CurrentRegion.Resize(, 7) 'matrice, plus rapide
ReDim resu(1 To UBound(tablo), 1 To 7)
For i = 1 To UBound(tablo)
    If Not d.exists(tablo(i, 4) & tablo(i, 3) & tablo(i, 7)) Then
        n = n + 1
        For j = 1 To 7: resu(n, j) = tablo(i, j): Next j
    End If
Next i
'---restitution---
If FilterMode Then ShowAllData 'si la feuille est filtrée
With [A2] '1ère cellule de destination
    If n Then .Resize(n, 7) = resu
    .Offset(n).Resize(Rows.Count - n - .Row + 1, 7).ClearContents 'RAZ en dessous
End With
End Sub

Elle se déclenche quand on active la feuille.

Elle est très rapide car elle utilise des tableaux VBA et le Dictionary.

A+

Jean-Eric · 10 Novembre 2022

Bonjour,
Une proposition Power Query.
Cdlt.

fil28 · 14 Novembre 2022

Bonjour le Forum Job75, Jean-Eric,

J'espère que le long week end a été bon ?
Merci beaucoup pour vos réponses.
Le code Job75 marche très bien. Super !!
Je ne connais pas trop PowerQuery ca sera l'occasion que je me documente

Merci encore
Philippe

fil28 · 14 Novembre 2022

Dernière question,

J'aimerais comprendre ce qui ne va pas pas dans le code suivant :
Je pense que la double boucle est mal construite mais je ne vois pas d'où ca vient

Merci beaucoup
Philippe

Sub test()
Dim J, Z, D, F As Variant

Dim Final As Integer
Dim Depart As Integer

Depart = Feuil3.Cells(Rows.Count, 1).End(xlUp).Row
Final = Feuil2.Cells(Rows.Count, 1).End(xlUp).Row

Feuil5.Select

'Feuil2 = Final
'Feuil3 = départ
Z = 2
For D = 1 To Depart

For F = 1 To Final

If Feuil3.Cells(D, 3).Value = Feuil2.Cells(F, 3).Value And _
Feuil3.Cells(D, 4).Value = Feuil2.Cells(F, 4).Value And _
Feuil3.Cells(D, 7).Value = Feuil2.Cells(F, 7).Value Then
GoTo Sauter

ElseIf F.Value = Final Then
Feuil5.Cells(Z, 3).Value = Feuil3.Cells(F, 3).Value
Feuil5.Cells(Z, 4).Value = Feuil3.Cells(F, 4).Value
Feuil5.Cells(Z, 7).Value = Feuil3.Cells(F, 7).Value
Z = Z + 1
GoTo Sauter

Else
Next F
End If

Sauter:

Next D

End Sub

XL 2016 Comparer 2 tableaux

fil28

XLDnaute Nouveau

Pièces jointes

job75

XLDnaute Barbatruc

Pièces jointes

Jean-Eric

XLDnaute Occasionnel

Pièces jointes

fil28

XLDnaute Nouveau

fil28

XLDnaute Nouveau

Discussions similaires