1、Sub 重复行删除()
Dim R As Integer '表格中行总数
Dim L As Integer '表格中列总数
Dim i1 As Integer '行递增循环
Dim i2 As Integer '行递增循环(当前行的下一行开始）
Dim j As Integer '列递增循环
Dim flag As Boolean
R = ActiveSheet.UsedRange.Rows.Count
L = ActiveSheet.UsedRange.Columns.Count
Dim HB As Integer
HB = 0
'MsgBox R
'MsgBox L
For i1 = 1 To R Step 1
If (i1 + HB > R) Then '如果已经合并删除的行与已循环过的行之和大于循环前总行数则停止循环
Exit For
End If
Application.ScreenUpdating = False
For i2 = R To i1 + 1 Step -1
flag = True
For j = 1 To L Step 1
If Cells(i1, j) <> Cells(i2, j) Then
flag = False
Exit For '如果发现两行中单元格有不同，则退出本次循环
End If
Next j
If flag Then
Cells(i2, 1).EntireRow.Delete
HB = HB + 1 '删除一行最外层循环就减1
End If
Next i2
Application.ScreenUpdating = True
Next i1
End Sub
Sub 重复行合并计算()
Dim R As Integer '表格中行总数
Dim L As Integer '表格中列总数
Dim i1 As Integer '行递增循环
Dim i2 As Integer '行递增循环(当前行的下一行开始）
Dim j As Integer '列递增循环
R = ActiveSheet.UsedRange.Rows.Count
L = ActiveSheet.UsedRange.Columns.Count
Dim HB As Integer
HB = 0
'MsgBox R
'MsgBox L
For i1 = 1 To R Step 1
If (i1 + HB > R) Then '如果已经合并计算的行与已循环过的行之和大于循环前总行数则停止循环
Exit For
End If
For i2 = R To i1 + 1 Step -1
If Cells(i1, 1) = Cells(i2, 1) Then '选择第1列作为判断是否重复列
Cells(i1, 2) = Cells(i1, 2) + Cells(i2, 2) '选择第2列作为合并计算列
Cells(i2, 1).EntireRow.Delete
HB = HB + 1 '删除一行最外层循环就减1
End If
Next i2
Next i1
End Sub
