Moin,
wenn ich leise weinend annehme, dass
nur Länder mit numerischen Einheiten erfasst sind
und Blockende sinnvoll immer größer als Blockbeginn
würde ich
erst nach Land sortieren
danach von der letzten Zeile beginnend etwa so
(kann dauern, aber was solls)
Option Explicit
Sub test()
Dim lRow As Long, x As Long
'
lRow = Cells(Rows.Count, 1).End(xlUp).Row
'
Application.ScreenUpdating = False
'
With ActiveSheet.Sort
With .SortFields
.Clear
.Add Key:=Range(Cells(2, 1), Cells(lRow, 1)), _
SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
.Add Key:=Range(Cells(2, 2), Cells(lRow, 2)), _
SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
End With
.SetRange ActiveSheet.UsedRange
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
'
For x = lRow To 2 Step -1
If Cells(x - 1, 1).Value = Cells(x, 1).Value Then
Cells(x - 1, 3).Value = Cells(x, 3).Value
Rows(x).Delete
End If
Next x
'
Application.ScreenUpdating = True
'
End Sub
|