Option Explicit
Sub SuppressionTVAColonneD_C()
' macro qui va permettre de faire recherche avec une clé pour supprimer les lignes inutiles.
' en Colonne D ou C2 les sommes qui représente environ 50% de la TVA qui vient s'ajouter.
'
' 1) Copie la somme "D" ou "C2" / crée une clé
' - Colonne 12 copie la somme de la colonne "D" ou "C2"
' - Colonne 13 crée une clé avec les colonnes N & P & Le code de la colonne somme soit "D" ou "C2" & C & D
' 2) Identification de la ligne avec couleur jaune
' - A Partir de la clé créer
' 3) Puis suppression de cette ligne
' - A Partir de la couleur jaune générer sur la feuille Excel.
'
Application.ScreenUpdating = False
'
Dim t(0 To 1) As Variant
Dim Temp() As Variant
Dim a() As Variant
Dim i, j As Long
t(0) = Range(Cells(1, 1), Cells(Cells(65536, 1).End(xlUp).Row, Cells(1, Cells.Columns.Count).End(xlToLeft).Column))
Set t(1) = Range(Cells(1, 1), Cells(Cells(65536, 1).End(xlUp).Row, Cells(1, Cells.Columns.Count).End(xlToLeft).Column))
Temp = t(0)
ReDim Preserve Temp(LBound(t(0), 1) To UBound(t(0), 1), LBound(t(0), 2) To UBound(t(0), 2) + 2)
t(0) = Temp
Erase Temp
' 1) Copie la somme "D" ou "C2" / crée une clé
For i = LBound(t(0), 1) + 1 To UBound(t(0), 1)
If t(0)(i, 8) > 0 Then
t(0)(i, 12) = t(0)(i, 8) ' ........................................................ Somme
t(0)(i, 13) = t(0)(i, 7) & "-" & t(0)(i, 10) & "-" & "D" & "-" & t(0)(i, 3) & "-" & t(0)(i, 4) ' .... Clé
Else
t(0)(i, 12) = t(0)(i, 9) ' ........................................................ Somme
t(0)(i, 13) = t(0)(i, 7) & "-" & t(0)(i, 10) & "-" & "C2" & "-" & t(0)(i, 3) & "-" & t(0)(i, 4) ' .... Clé
End If
Next i
i = Empty
' 2) Identification de la ligne avec couleur jaune
For i = LBound(t(0), 1) + 1 To UBound(t(0), 1)
For j = i + 1 To UBound(t(0), 1)
If t(0)(i, 13) = t(0)(j, 13) Then
a = Array(t(0)(i, 12), t(0)(j, 12))
If Application.Min(a) = t(0)(i, 12) Then
Range(t(1).Cells(i, 1), t(1).Cells(i, UBound(t(0), 2) - 2)).Interior.Color = 65535
ElseIf Application.Min(a) = t(0)(j, 12) Then
Range(t(1).Cells(j, 1), t(1).Cells(j, UBound(t(0), 2) - 2)).Interior.Color = 65535
End If
Erase a
End If
Next j
Next i
i = Empty: j = Empty
' 3) Puis suppression de cette ligne
For i = t(1).Rows.Count To 1 Step -1
If Range(t(1).Cells(i, 1), t(1).Cells(i, UBound(t(0), 2) - 2)).Interior.Color = 65535 Then
Range(t(1).Cells(i, 1), t(1).Cells(i, UBound(t(0), 2) - 2)).Delete
End If
Next i
Erase t
i = Empty: j = Empty
Erase t
Application.ScreenUpdating = True
End Sub