VBA：合并具有相同ID号的单元格

基本上，我想要创build一个macros，合并那些相同的ID的SUM列。 在条件格式中，对于列C，将如下所示：= OR（A1 = A2; A2 = A3）

ID QTY SUM > ID QTY SUM 001 1 1 > 001 1 1 002 2 5 > 002 2 5 002 3 5 > 002 3 003 4 4 > 003 4 4 

见示例

我相信这应该很简单。

非常感谢！

Answer 1

这应该做的工作。

 Option Explicit Private Sub MergeCells() ' Disable screen updates (such as warnings, etc.) Application.ScreenUpdating = False Application.DisplayAlerts = False Dim rngMerge As Range, rngCell As Range, mergeVal As Range Dim i As Integer Dim wks As Worksheet Set wks = ThisWorkbook.Sheets("Sheet1") ' Change Sheet1 to your worksheet i = wks.Range("A2").End(xlDown).Row Set rngMerge = wks.Range("A2:A" & i) ' Find last row in column A With wks ' Loop through Column A For Each rngCell In rngMerge ' If Cell value is equal to the cell value below and the cell is not empty then If rngCell.Value = rngCell.Offset(1, 0).Value And IsEmpty(rngCell) = False Then ' Define the range to be merged ' Be aware that warnings telling you that the 2 cells contain 2 differen values will be ignored ' If you have 2 different sums in column C, then it will use the first of those Set mergeVal = wks.Range(rngCell.Offset(0, 2), rngCell.Offset(1, 2)) With mergeVal .Merge .HorizontalAlignment = xlCenter .VerticalAlignment = xlCenter End With End If Next End With Application.DisplayAlerts = True Application.ScreenUpdating = True End Sub 

Answer 2

到目前为止，我正在使用下面的代码：

 Sub MergeSum() Set Rng = ActiveSheet.Range("A1:A5") Dim nIndex As Long Dim iCntr As Long For iCntr = 1 To 5 If Cells(iCntr, 1) <> "" Then nIndex = WorksheetFunction.Match(Cells(iCntr, 1), Rng, 0) If iCntr <> nIndex Then Let Obj = "C" & nIndex & ":" & "C" & iCntr Range(Obj).Select Application.DisplayAlerts = False Selection.Merge Application.DisplayAlerts = True End If End If Next End Sub 

但是这个代码有一个限制，它只能使用上行ID。