Microsoft 365 Macro vba comparaison / insertion

[tof1584]

Bonjour,
Je galère depuis un moment sur un problème que je rencontre. j'ai deux tableaux sur deux feuilles différentes, construits de la même manière.
Je veux comparer les colonnes B, et:
- pour chaque cellule B du feuillet 1 qui n'est pas présent dans le feuillet 2, au sein du feuillet 2:
- aller chercher la cellule inférieure la plus proche
- insérer une ligne vierge juste au dessus
- copier l'ensemble de la ligne contenant la cellule cible du feuillet 1 dans la ligne vierge insérer dans le feuillet 2.
-sinon, passer à la cellule B du feuillet 1 suivante
Ai-je été clair?
Exemple:
feuillet 1 colonne B:
3366
3352
3348
3312

feuillet 2 colonne B:
3360
3351
3348
3312

commencer la comparaison avec 3366, pas de correspondance trouvée, recherche de la valeur inférieure la plus proche, on trouve 3360, on insère une ligne vierge juste au dessus et on copie l'ensemble de la ligne de la cellule 3366.
puis 3352, idem, ligne inférieure plus proche = 3351
puis 3348, correspondance donc on passe à la suivante 3312
3312 a également une correspondance donc on passe à la suivante, etc....

Merci pour votre aide

 

[patricktoulon]

bonjour
le probleme c'est que les fonction equiv et match en vba l'argument "presque exac" (superieur ou inférieur)t n'a pas de limite si ce n'est que le premier inférieur ou le premier supérieur
donc conclusion
si tu a par exemple 3556 et et que tu a que 3000 ou 4000 dans l'autre feuille et rien entre les deux
selon l'argument tu aura l'un ou l'autre
ça fait un peu comparaison élastique selon moi
peut etre devrait tu nous en dire un peu plus sur ton projet

 

[tof1584]

bonjour Patrick de Toulon,

je ne peux pas mettre de modèle car ce sont des données confidentielles, cependant, le feuillet 1 (celui qui va être comparé à l'autre) est une extraction de données d'une plateforme de suivit de données interne à mon entreprise.
Le feuillet 2, est donc la base de données agencée de la même façon que l'extraction. Cette base de données permet ensuite d'alimenter des tableau de bord.
L’idée c’est que chaque mois une extraction soit faite, et vienne se comparer à la base de donnée socle, et s’il y a des différences, alors les lignes sont automatiquement intercalées au bon endroit.
Si je dois l'automatiser, c'est qu'à terme, ce sera une autre personne qui devra faire ce suivi, et partant du principe qu'elle maitrisera moins bien le système, plus c'est automatisé et mieux c'est.
En espérant avoir été plus complet.

 

[job75]

Bonjour tof1584, Patrick, le forum,

Testez cette macro :

Sub Comparaison()
Dim F1 As Worksheet, F2 As Worksheet, d, P As Range, tablo, i&, v, tablo1, j&, k As Variant
Set F1 = Sheets("Feuil1")
Set F2 = Sheets("Feuil2")
If F1.FilterMode Then F1.ShowAllData 'si la feuille est filtrée
If F2.FilterMode Then F2.ShowAllData 'si la feuille est filtrée
Set d = CreateObject("Scripting.Dictionary")
Set P = F2.Range("B1", F2.Range("B" & F2.Rows.Count).End(xlUp)(2)) 'au moins 2 éléments
tablo = P 'matrice, plus rapide
'---liste pour accélérer---
For i = 1 To UBound(tablo) - 1
    v = tablo(i, 1)
    If IsNumeric(CStr(v)) Then d(v) = ""
Next i
'---analyse de la 1ère feuille---
Application.ScreenUpdating = False
tablo1 = F1.Range("B1", F1.Range("B" & F1.Rows.Count).End(xlUp)(2)) 'matrice, plus rapide, au moins 2 éléments
For i = 1 To UBound(tablo1) - 1
    v = tablo1(i, 1)
    If IsNumeric(CStr(v)) Then
        If Not d.exists(v) Then
            d(v) = "" 'ajoute un élément au Dictionary
            tablo = P
            For j = 1 To UBound(tablo) - 1
                If tablo(j, 1) > v Then tablo(j, 1) = Empty
            Next j
            k = Application.Match(Application.Max(tablo), tablo, 0)
            If IsNumeric(k) Then
                k = P(k).Row 'mémorise le numéro de ligne
                F2.Rows(k).Insert 'insère une ligne au dessus
                F1.Rows(i).Copy F2.Cells(k, 1) 'copier-coller
            End If
        End If
    End If
Next i
End Sub

Elle est très rapide (s'il n'y a pas trop de lignes à insérer) car elle utilise des tableaux VBA et le Dictionary.

A+

 

[job75]

Une solution plus simple mais moins rapide sur de grands tableaux :

Sub Comparaison1()
Dim F1 As Worksheet, F2 As Worksheet, P As Range, c As Range, tablo, v, i&, j As Variant
Set F1 = Sheets("Feuil1")
Set F2 = Sheets("Feuil2")
Set P = F2.Range("B1:B" & F2.Cells.SpecialCells(xlCellTypeLastCell).Row + 1) 'au moins 2 éléments
Application.ScreenUpdating = False
For Each c In F1.Range("B1:B" & F1.Cells.SpecialCells(xlCellTypeLastCell).Row)
    If IsNumeric(CStr(c)) Then
        If Application.CountIf(P, c) = 0 Then
            tablo = P 'matrice, plus rapide
            v = c
            For i = 1 To UBound(tablo) - 1
                If tablo(i, 1) > v Then tablo(i, 1) = Empty
            Next i
            j = Application.Match(Application.Max(tablo), tablo, 0)
            If IsNumeric(j) Then
                F2.Rows(j).Insert 'insère une ligne au dessus
                c.EntireRow.Copy F2.Cells(j, 1) 'copier-coller
                If j = 1 Then Set P = F2.Range("B1", P)
            End If
        End If
    End If
Next c
End Sub

 

[job75]

Les durées d'exécution dépendent bien sûr surtout du nombre de lignes à insérer.

J'ai testé avec des colonnes de 10 000 lignes remplies de nombres aléatoires compris entre 1000 et 9999.

1967 lignes sont insérées :

- macro Comparaison => 17,4 secondes chez moi sur Win 11 Excel 2019

- macro Comparaison1 => 23,3 secondes.

 

[tof1584]

bonjour,
merci pour ce retour
j'ai essayé de l'adapter à mon cas, et lorsque je mets tablo(i,2) ça ne le prend pas. La comparaison devant se faire par rapport aux données de la colonne B, il me paraissait logique de procéder ainsi.

 

[job75]

Bonjour,

Vous vous réveillez mais mal.

Dans mes exemples tablo représente la colonne B donc on utilise tablo(i, 1) 1ère colonne de la plage

A+

 

[tof1584]

merci à vous
top