1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75
|
Sub A_INTEGRER2()
Dim Base As Worksheet
Dim data As Worksheet
Dim BL As Range
Dim ACVAL As Range
Dim i As Integer
Dim j As Integer
Dim rngSource As Range
Dim rngTarget As Range
Const StartRow As Long = 1
Const StartCol As Integer = 1
Set Base = ThisWorkbook.Sheets("A INTEGRER")
Set data = ThisWorkbook.Sheets("DATA")
Set BL = Base.Range(" A1")
BL = BL.Offset(0)
Set ACVAL = data.Range("A1")
ACVAL = ACVAL.Offset(0)
i = 0
j = 0
For i = 0 To 29 'Ici on va vérifier les 30 ligne de l'onglet "A INTEGRER" (meme si elles sont vide) A ADAPTER
Do While ACVAL.Offset(j, 0) <> "" 'on vérifie tous les lignes de l'onglet "DATA"
If BL.Offset(i, 1) = ACVAL.Offset(j, 1) And BL.Offset(i, 2) = ACVAL.Offset(j, 2) And BL.Offset(i, 4) = ACVAL.Offset(j, 4) And BL.Offset(i, 6) = ACVAL.Offset(j, 6) And BL.Offset(i, 7) = ACVAL.Offset(j, 7) Then
ACVAL.Offset(j, 8) = ACVAL.Offset(j, 8) + 1 'Si les données des colonnes B, C, E, G et H sont identiques on incrémente la colonne I de la feuille "DATA"
ACVAL.Offset(j, 0) = BL.Offset(i, 0) 'ici on actualise la date de la ligne identique à celle dans l'onglet"A INTEGRER"
BL.Offset(i, 8) = 1 'Si les données des colonnes B, C, E, G et H sont identiques on marquela la ligne de la feuille "A INTEGRER"
'on pourra ensuite selectionner et supprimer ces lignes et ne copier dans l'onglet "DATA" que celles qui ont des diffèrences
i = i + 1
j = 0
Else
i = i
j = j + 1
End If
Loop
j = 0
Next i
i = 0
j = 0
Do While BL.Offset(i, 0) <> ""
If BL.Offset(i, 8) = 1 Then
With thisworkbooks
Set rngSource = .Worksheets("A INTEGRER").Range(BL.Offset(i, 0)).CurrentRegion
Set rngTarget = Range("A65000").End(xlUp).Offset(1)
End With
With rngSource
Set rngSource = .Offset(StartRow - 1, StartCol - 1).Resize(.Rows.Count - StartRow + 1, .Columns.Count - StartCol + 1)
End With
rngSource.Delete
i = 0
Else
i = i + 1
End If
Set BL = Base.Range(" A1")
Loop
i = 0
rngSource.Copy rngTarget
Do While ACVAL.Offset(j, 0) <> ""
If ACVAL.Offset(j, 8) = "" Then 'ici met la valeur 1 en colonne I pour les nouvelles lignes
ACVAL.Offset(j, 8) = 1
End If
j = j + 1
Loop
rngSource.Delete
End Sub |
Partager