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 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141
| Sub doublon()
'sous procédure de vérification des doublons
'masquer les actions de la macro
Application.ScreenUpdating = False
derlgn = Workbooks(classeuract).Sheets(1).Cells(Workbooks(classeuract).Sheets(1).Columns(1).Cells.Count, 1).End(xlUp).Row
'numéroter les lignes de facon à pouvoir les remettre dans le bon ordre à la fin
For m = 6 To derlgn
Workbooks(classeuract).Sheets(1).Cells(m, 22) = m - 5
Next m
'trier la plage pour regrouper les doublons
Workbooks(classeuract).Sheets(1).Sort.SortFields.Clear
Workbooks(classeuract).Sheets(1).Sort.SortFields.Add Key:=Range("B6:B" & derlgn), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortTextAsNumbers
Workbooks(classeuract).Sheets(1).Sort.SortFields.Add Key:=Range("D6:D" & derlgn), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortTextAsNumbers
Workbooks(classeuract).Sheets(1).Sort.SortFields.Add Key:=Range("E6:E" & derlgn), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortTextAsNumbers
Workbooks(classeuract).Sheets(1).Sort.SortFields.Add Key:=Range("H6:H" & derlgn), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortTextAsNumbers
Workbooks(classeuract).Sheets(1).Sort.SortFields.Add Key:=Range("I6:I" & derlgn), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortTextAsNumbers
Workbooks(classeuract).Sheets(1).Sort.SortFields.Add Key:=Range("K6:K" & derlgn), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortTextAsNumbers
Workbooks(classeuract).Sheets(1).Sort.SortFields.Add Key:=Range("P6:P" & derlgn), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortTextAsNumbers
Workbooks(classeuract).Sheets(1).Sort.SortFields.Add Key:=Range("Q6:Q" & derlgn), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortTextAsNumbers
With Workbooks(classeuract).Sheets(1).Sort
.SetRange Range("A5:V" & derlgn)
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
'on part du bas pour éviter ls problemes quand on suprime la ligne ne cours
For m = derlgn To 6 Step -1
'si le pn fournisseur est le même sur la ligne m et la ligne m-1, alors
If Workbooks(classeuract).Sheets(1).Cells(m, 2) = Workbooks(classeuract).Sheets(1).Cells(m - 1, 2) Then
'vérifier si tout les champs significatif sont identiques, si oui, effacer la ligne
If Workbooks(classeuract).Sheets(1).Cells(m, 2) & Workbooks(classeuract).Sheets(1).Cells(m, 4) & Workbooks(classeuract).Sheets(1).Cells(m, 5) & Workbooks(classeuract).Sheets(1).Cells(m, 8) & Workbooks(classeuract).Sheets(1).Cells(m, 9) & Workbooks(classeuract).Sheets(1).Cells(m, 11) & Workbooks(classeuract).Sheets(1).Cells(m, 16) & Workbooks(classeuract).Sheets(1).Cells(m, 17) = Workbooks(classeuract).Sheets(1).Cells(m - 1, 2) & Workbooks(classeuract).Sheets(1).Cells(m - 1, 4) & Workbooks(classeuract).Sheets(1).Cells(m - 1, 5) & Workbooks(classeuract).Sheets(1).Cells(m - 1, 8) & Workbooks(classeuract).Sheets(1).Cells(m - 1, 9) & Workbooks(classeuract).Sheets(1).Cells(m - 1, 11) & Workbooks(classeuract).Sheets(1).Cells(m - 1, 16) & Workbooks(classeuract).Sheets(1).Cells(m - 1, 17) Then
Workbooks(classeuract).Sheets(1).Rows(m & ":" & m).Delete
End If
End If
'si le pn fournisseur est le même sur la ligne m et la ligne m-1, alors
If Workbooks(classeuract).Sheets(1).Cells(m, 2) = Workbooks(classeuract).Sheets(1).Cells(m - 1, 2) Then
'vérifier si la seconde ligne est incomplete et que la premiere est complete, alors
'effacer la seconde
'normalement, à cause du tri, ca sera toujours dans ce sens la, les vides étant trié
'apres les pleins
If (Replace(Workbooks(classeuract).Sheets(1).Cells(m, 18), "Nom trop long", "") <> "") And (Replace(Workbooks(classeuract).Sheets(1).Cells(m - 1, 18), "Nom trop long", "") = "") Then
Workbooks(classeuract).Sheets(1).Rows(m & ":" & m).Delete
End If
End If
'si le pn fournisseur est le même sur la ligne m et la ligne m-1, alors
If Workbooks(classeuract).Sheets(1).Cells(m, 2) = Workbooks(classeuract).Sheets(1).Cells(m - 1, 2) Then
'traiter les doublons quand les deux sont complets ou tout les deux sont incomplets avec
'des différences entres les deux lignes
'si la différence est au niveau du prix d'achat
If Workbooks(classeuract).Sheets(1).Cells(m, 4) <> Workbooks(classeuract).Sheets(1).Cells(m - 1, 4) Then
k = m
Excel.Run ("retourchariot")
Workbooks(classeuract).Sheets(1).Cells(m, 18) = Workbooks(classeuract).Sheets(1).Cells(m, 18) & "doublon différence prix d'achat"
k = m - 1
Excel.Run ("retourchariot")
Workbooks(classeuract).Sheets(1).Cells(m - 1, 18) = Workbooks(classeuract).Sheets(1).Cells(m - 1, 18) & "doublon différence prix d'achat"
End If
'si la différence est au niveau du prix de vente
If Workbooks(classeuract).Sheets(1).Cells(m, 5) <> Workbooks(classeuract).Sheets(1).Cells(m - 1, 5) Then
k = m
Excel.Run ("retourchariot")
Workbooks(classeuract).Sheets(1).Cells(m, 18) = Workbooks(classeuract).Sheets(1).Cells(m, 18) & "doublon différence prix de vente"
k = m - 1
Excel.Run ("retourchariot")
Workbooks(classeuract).Sheets(1).Cells(m - 1, 18) = Workbooks(classeuract).Sheets(1).Cells(m - 1, 18) & "doublon différence prix de vente"
End If
'si la différence est au niveau de la famille
If Workbooks(classeuract).Sheets(1).Cells(m, 8) <> Workbooks(classeuract).Sheets(1).Cells(m - 1, 8) Then
k = m
Excel.Run ("retourchariot")
Workbooks(classeuract).Sheets(1).Cells(m, 18) = Workbooks(classeuract).Sheets(1).Cells(m, 18) & "doublon différence famille"
k = m - 1
Excel.Run ("retourchariot")
Workbooks(classeuract).Sheets(1).Cells(m - 1, 18) = Workbooks(classeuract).Sheets(1).Cells(m - 1, 18) & "doublon différence famille"
End If
'si la différence est au niveau de la sous famille
If Workbooks(classeuract).Sheets(1).Cells(m, 9) <> Workbooks(classeuract).Sheets(1).Cells(m - 1, 9) Then
k = m
Excel.Run ("retourchariot")
Workbooks(classeuract).Sheets(1).Cells(m, 18) = Workbooks(classeuract).Sheets(1).Cells(m, 18) & "doublon différence sous-famille"
k = m - 1
Excel.Run ("retourchariot")
Workbooks(classeuract).Sheets(1).Cells(m - 1, 18) = Workbooks(classeuract).Sheets(1).Cells(m - 1, 18) & "doublon différence sous-famille"
End If
'si la différence est au niveau du type (récupel ou non)
If Workbooks(classeuract).Sheets(1).Cells(m, 11) <> Workbooks(classeuract).Sheets(1).Cells(m - 1, 11) Then
k = m
Excel.Run ("retourchariot")
Workbooks(classeuract).Sheets(1).Cells(m, 18) = Workbooks(classeuract).Sheets(1).Cells(m, 18) & "doublon différence type (récupel)"
k = m - 1
Excel.Run ("retourchariot")
Workbooks(classeuract).Sheets(1).Cells(m - 1, 18) = Workbooks(classeuract).Sheets(1).Cells(m - 1, 18) & "doublon différence type (récupel)"
End If
'si la différence est au niveau de la quantité minimum
If Workbooks(classeuract).Sheets(1).Cells(m, 16) <> Workbooks(classeuract).Sheets(1).Cells(m - 1, 16) Then
k = m
Excel.Run ("retourchariot")
Workbooks(classeuract).Sheets(1).Cells(m, 18) = Workbooks(classeuract).Sheets(1).Cells(m, 18) & "doublon différence Qté min"
k = m - 1
Excel.Run ("retourchariot")
Workbooks(classeuract).Sheets(1).Cells(m - 1, 18) = Workbooks(classeuract).Sheets(1).Cells(m - 1, 18) & "doublon différence Qté min"
End If
'si la différence est au niveau de la devis d'achat
If Workbooks(classeuract).Sheets(1).Cells(m, 17) <> Workbooks(classeuract).Sheets(1).Cells(m - 1, 17) Then
k = m
Excel.Run ("retourchariot")
Workbooks(classeuract).Sheets(1).Cells(m, 18) = Workbooks(classeuract).Sheets(1).Cells(m, 18) & "doublon différence devise achat"
k = m - 1
Excel.Run ("retourchariot")
Workbooks(classeuract).Sheets(1).Cells(m - 1, 18) = Workbooks(classeuract).Sheets(1).Cells(m - 1, 18) & "doublon différence devise achat"
End If
End If
Next m
'je remet un derlgn pour le réactualiser apres la supression des doublons
derlgn = Workbooks(classeuract).Sheets(1).Cells(Workbooks(classeuract).Sheets(1).Columns(1).Cells.Count, 1).End(xlUp).Row
'remettre les informations dans l'ordre en utilisant la colonne V qu'on a numéroté en début de procédure
Workbooks(classeuract).Sheets(1).Sort.SortFields.Clear
Workbooks(classeuract).Sheets(1).Sort.SortFields.Add Key:=Range("V6:V" & derlgn), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortTextAsNumbers
With Workbooks(classeuract).Sheets(1).Sort
.SetRange Range("A5:V" & derlgn)
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
Workbooks(classeuract).Sheets(1).Columns("V:V").Delete
Application.ScreenUpdating = True
End Sub |
Partager