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
| Dim CelTestColA As Range
Dim PlageFactureOuverteColA As String
Dim TotalIntermediaire As Integer
Dim DebutLigneSuppression As Integer
Dim LastCell As Integer
Sub test()
'on trie sur le nom de la 1) et de la 2° colonne
Range("a1").Select
Selection.Sort Key1:=Range("A2"), Order1:=xlAscending, Key2:=Range("B2") _
, Order2:=xlAscending, Header:=xlGuess, OrderCustom:=1, MatchCase:= _
False, Orientation:=xlTopToBottom
'on fait les totaux en cas d'égalité de cola et colb
PlageFactureOuverteColA = "a2:a" & Range("a65536").End(xlUp).Row
LastCell = Range("a65536").End(xlUp).Row
For Each CelTestColA In Range(PlageFactureOuverteColA)
If CelTestColA = CelTestColA.Offset(1, 0) Then
If CelTestColA.Offset(0, 1) = CelTestColA.Offset(1, 1) Then
TotalIntermediaire = CelTestColA.Offset(0, 2).Value + CelTestColA.Offset(1, 2).Value
CelTestColA.Offset(1, 2).Value = TotalIntermediaire
CelTestColA.Offset(0, 2).Value = 0
End If
End If
Next
'on efface les lignes inutiles
Selection.Sort Key1:=Range("C2"), Order1:=xlDescending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
Columns("C:C").Select
Selection.Find(What:="0", After:=ActiveCell, LookIn:=xlFormulas, LookAt _
:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
False).Activate
DebutLigneSuppression = ActiveCell.Row
Range("A" & DebutLigneSuppression & ":C" & LastCell).Select
Selection.Delete Shift:=xlUp
'on retrie sur la première colonne
Selection.Sort Key1:=Range("A2"), Order1:=xlAscending, Key2:=Range("B2") _
, Order2:=xlAscending, Header:=xlGuess, OrderCustom:=1, MatchCase:= _
False, Orientation:=xlTopToBottom
End Sub |
Partager