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
| Sub Preparation()
Dim Sem1 As Byte, Sem2 As Byte
Dim LastLig As Long, i As Long
Application.ScreenUpdating = False
'Récupération des semaines 1 et 2
With ThisWorkbook.Worksheets("Comparaison")
Sem1 = .Range("A3")
Sem2 = .Range("B3")
End With
With ThisWorkbook.Worksheets("Feuil2")
'On efface la feuille de destination
.UsedRange.Clear
'On copie l'ensemble des données de la feuille source vers la feuille destination
ThisWorkbook.Worksheets("Feuil1").UsedRange.Copy .Range("A1")
'On filtre sur les semaines différentes de Sem1 et de Sem2
LastLig = .Cells(.Rows.Count, 1).End(xlUp).Row
.Range("AH1:AH" & LastLig).AutoFilter Field:=1, Criteria1:="<>" & Sem1, Criteria2:="<>" & Sem2, Operator:=xlAnd
'On efface les lignes ne correspondants pas aux 2 semaines
If .Range("AH1:AH" & LastLig).SpecialCells(xlCellTypeVisible).Count > 1 Then .Range("AH2:AH" & LastLig).SpecialCells(xlCellTypeVisible).EntireRow.Delete
.AutoFilterMode = False
'On supprime les lignes identiques (doublons) par rapport aux colonnes 2, 6,9,10,18,21,32 et 33 >>>A ADAPTER POUR REPONDRE A LA QUESTION LEGITIME DE DANIEL C
'Ou même on peut facilement avoir une liste dynamique de colonnes prises en compte selon le besoin
LastLig = .Cells(.Rows.Count, 1).End(xlUp).Row
.Range("A1:AH" & LastLig).RemoveDuplicates Columns:=Array(2, 6, 9, 10, 18, 21, 32, 33), Header:=xlYes
'On tri par rapport MEC pour regrouper les lignes à comparer (pour facilter le traitement ultérieur)
LastLig = .Cells(.Rows.Count, 1).End(xlUp).Row
.Range("A1:AH" & LastLig).Sort key1:=.Range("T1"), Order1:=xlAscending, Header:=xlYes, key2:=.Range("A1"), Order2:=xlAscending
'On ajoute les lignes éventuellement supprimées ou ajoutées entre les 2 semaines
For i = LastLig To 2 Step -1
If Application.WorksheetFunction.CountIfs(.Range("B2:B" & LastLig), .Range("B" & i), .Range("T2:T" & LastLig), .Range("T" & i)) = 1 Then
If .Range("AH" & i) = Sem1 Then
.Rows(i + 1).Insert
.Range("B" & i + 1) = .Range("B" & i)
.Range("AH" & i + 1) = Sem2
Else
.Rows(i).Insert
.Range("B" & i) = .Range("B" & i + 1)
.Range("AH" & i) = Sem1
End If
End If
Next i
'Il ne restera que supprimer les colonnes indésirée
End With
End Sub |
Partager