Comparer 2 tables

[Ber Nar]

Bonjour à tous !

Voilà mon souci :

J'ai construit (il y a longtemps) une macro xl4 qui compare la 1ère colonne de 2 tables (triées par ordre croissant) et qui insère une ligne dans l'une des deux tables lorsque les 2 données comparées sont différentes.

J'aimerais pouvoir écrire cette macro en procédure VBA. quelqu'un peut-il m'aider ?

=ECRAN(FAUX)
=TANT.QUE(CELLULE.ACTIVE()<>"")
Debut=LIRE.CELLULE(5)
=SELECTIONNER("LC11")
=SI(CELLULE.ACTIVE()=Debut;ATTEINDRE(A7);SI(CELLULE.ACTIVE()>Debut;ATTEINDRE(A9);SI(CELLULE.ACTIVE()="";ATTEINDRE(A17);ATTEINDRE(A13))))
=SELECTIONNER("L(1)C1")
=ATTEINDRE(A3)
=SELECTIONNER("LC:LC17")
=INSERER(2)
=SELECTIONNER("L(1)C1")
=ATTEINDRE(A3)
=SELECTIONNER("LC1:LC10")
=INSERER(2)
=SELECTIONNER("L(1)C1")
=ATTEINDRE(A3)
=SUIVANT()
=RETOUR()

Par ailleurs, j'aimerais pouvoir indiquer au moyen d'une boite de dialogue, les coordonnées et longueurs des 2 tables.

Votre aide m'est précieuse.

Merci par avance.

Ber Nar.

 

[sousou]

Voilà qui devrait t'aider en tous les cas avec des nombres.


Sub test()
Set debtable1 = ThisWorkbook.Worksheets(1).Range("a1")
Set debtable2 = ThisWorkbook.Worksheets(1).Range("b1")

inc1 = 0
inc2 = 0
While debtable1.Offset(inc1, 0) <> ""
Set donnée1 = debtable1.Offset(inc1, 0)
Set donnée2 = debtable2.Offset(inc1, 0)
If donnée1 = donnée2 Then GoTo suite
If donnée1 = "" Then debtable1.Offset(inc1, 0) = debtable2.Offset(inc1, 0)
If donnée2 = "" Then debtable2.Offset(inc1, 0) = debtable1.Offset(inc1, 0)
If donnée2 < donnée1 Then
donnée1.Insert (xlShiftDown)
debtable1.Offset(inc1, 0) = debtable2.Offset(inc1, 0)
Else
donnée2.Insert (xlShiftDown)
debtable2.Offset(inc1, 0) = debtable1.Offset(inc1, 0)
End If

suite:
inc1 = inc1 + 1

Wend

 

[Jon]

'pour ceux que cela intéresse, j'ai eu quelques problèmes pour l'insertion, alors j'ai été obligé de manipuler les zones (areas) de l'objet rgTarget. Cela marche mais ce n'est pas trop beau.

cela suppose l'existence de deux plages nommées table1 & table2

Sub d()
Dim i As Integer
Dim cl
Dim rgTarget As Range
Application.ScreenUpdating = False

For Each cl In [table1].Columns(1).Cells
i = i + 1
If cl <> [table2].Columns(1).Cells.Item(i) Then
If Not rgTarget Is Nothing Then
Set rgTarget = Union(rgTarget, [table2].Columns(1).Cells.Item(i).EntireRow)
Else
Set rgTarget = [table2].Columns(1).Cells.Item(i).EntireRow
End If

End If
Next cl
rgTarget.Select
If Not rgTarget Is Nothing Then
For j = 1 To rgTarget.Areas.Count
For Each rw In rgTarget.Areas(j).Rows
x = x & rw.Address & IIf(j < rgTarget.Areas.Count, ",", "")
Next rw
Next j
End If

Range(x).Insert shift:=xlDown
End Sub