|
先将表格的B、C、D、E、F列按升序排序,如果B、C、D、E列有相同的行,对应的F列合并、G列合并,计算H列合计面积。
Sub MergeAndSumData()
Dim ws As Worksheet
Dim lastRow As Long
Dim i As Long
' 遍历工作表
For Each ws In ThisWorkbook.Worksheets
' 检查是否为需要操作的表格
If ws.Name Like "b8" Then ' 将"Table*"替换为你要操作的表格的名称
' 获取最后一行数据
lastRow = ws.Cells(ws.Rows.Count, "B").End(xlUp).Row
' 按B、C、D、E、F列按升序排序
ws.Sort.SortFields.Clear
ws.Sort.SortFields.Add Key:=Range("B3:B" & lastRow), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
ws.Sort.SortFields.Add Key:=Range("C3:C" & lastRow), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
ws.Sort.SortFields.Add Key:=Range("D3:D" & lastRow), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
ws.Sort.SortFields.Add Key:=Range("E3:E" & lastRow), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
ws.Sort.SortFields.Add Key:=Range("F3:F" & lastRow), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
With ws.Sort
.SetRange Range("A3:I" & lastRow)
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
' 合并F列和G列相同的值
For i = lastRow To 2 Step -1
If ws.Cells(i, "B").Value = ws.Cells(i - 1, "B").Value And _
ws.Cells(i, "C").Value = ws.Cells(i - 1, "C").Value And _
ws.Cells(i, "D").Value = ws.Cells(i - 1, "D").Value And _
ws.Cells(i, "E").Value = ws.Cells(i - 1, "E").Value Then
ws.Cells(i, "F").Value = ws.Cells(i, "F").Value & ", " & ws.Cells(i - 1, "F").Value
ws.Cells(i, "G").Value = ws.Cells(i, "G").Value & ", " & ws.Cells(i - 1, "G").Value
ws.Rows(i - 1).Delete
End If
Next i
' 求合同一组B、C、D、E列的H列
lastRow = ws.Cells(ws.Rows.Count, "B").End(xlUp).Row
For i = lastRow To 2 Step -1
If ws.Cells(i, "B").Value = ws.Cells(i - 1, "B").Value And _
ws.Cells(i, "C").Value = ws.Cells(i - 1, "C").Value And _
ws.Cells(i, "D").Value = ws.Cells(i - 1, "D").Value And _
ws.Cells(i, "E").Value = ws.Cells(i - 1, "E").Value Then
ws.Cells(i, "H").Value = ws.Cells(i, "H").Value + ws.Cells(i - 1, "H").Value
ws.Rows(i - 1).Delete
End If
Next i
End If
Next ws
End Sub
以上代码能实现按B、C、D、E合并F和G列值,但H列求和不正确!!!!
|
|