Sub eee()
Lst = "Лист2"
NLst = Sheets.Count
' Sheets(Lst).Copy After:=Sheets(NLst)
Sheets(Lst).Copy
NLst = ActiveWorkbook.ActiveSheet.Name
Range("C:C,E:E,F:F,H:H,I:I").Delete Shift:=xlToLeft
Columns("B:B").Cut
Columns("D:D").Insert Shift:=xlToRight
NRow = Range("A2").End(xlDown).Row
CNRow = CStr(NRow)
ActiveWorkbook.Worksheets(NLst).Sort.SortFields.Clear
With ActiveWorkbook.Worksheets(NLst).Sort
.SortFields.Clear
With .SortFields
.Add Key:=Range("A2:A" + CNRow), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
.Add Key:=Range("B2:B" + CNRow), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
.Add Key:=Range("C2:C" + CNRow), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
.Add Key:=Range("D2:D" + CNRow), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
End With
.SetRange Range("A1:F" + CNRow)
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
FStr = ""
NN = ""
j = 0
For i = 2 To NRow
ii = CStr(i)
TStr = CStr(Range("A" + ii)) + Range("B" + ii) + Range("C" + ii) + Range("D" + ii)
If FStr = TStr Then
Range("G" + ii) = 0
Range("E" + NN) = Range("E" + NN) + Range("E" + ii)
Range("F" + NN) = Range("F" + NN) + Range("F" + ii)
Else
NN = ii
FStr = TStr
j = j + 1
Range("G" + ii) = j
End If
Next
With ActiveWorkbook.Worksheets(NLst).Sort
.SortFields.Clear
With .SortFields
.Add Key:=Range("G2:G" + CNRow), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
End With
.SetRange Range("A1:G" + CNRow)
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
j = 1
For i = 2 To NRow
If Range("G" + CStr(i)) = 0 Then
j = i
Else
Exit For
End If
Next
Range("G:G").Delete Shift:=xlToLeft
If j <> 1 Then
Rows("2:" + CStr(j)).Delete Shift:=xlUp
End If
Range("A1").Select
End Sub
Если Вы уже зарегистрированы на Портале - войдите в систему, если Вы еще не регистрировались - пройдите простую процедуру регистрации.