Macro for merging cells

问题

I have an Excel file with Invoice number in Column B, (B2:B14987), in Column C I have Item ID's, in Column D I have Sold Value, in Column E I have Invoice-Discount Value.

I need a macro to merge the Invoice Discount value cells based on Invoice number column, invoice numbers are repeated as there are different item ID's in one invoice.

For example: B1:B3 are the same invoice number, E1 is the common discount value for the invoices which are in B1:B3, E2:E3 are blank cells. So I want E1:E3 to be merged, with the value that was in E1.

回答1:

The following code does what I think you are asking for; as always, if I misunderstood, please clarify the question and we'll get there...

Create a Module in your spreadsheet, and paste in the following code:

Private Sub mergeAndAlign(r As Range)
    With r
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
        .MergeCells = True
    End With
End Sub

Sub mergeAll()
' step through column E
' merge all cells that have the same invoice number
' they are already sorted - and the value we need is in the first cell
' of the block to be merged
Dim r As Range
Dim prevItem As Range
Dim nextItem As Range
Dim lastRow, thisRow, rCount As Integer

lastRow = [B2].End(xlDown).Row

Set prevItem = [E2]
Set nextItem = prevItem.End(xlDown)

While nextItem.Row <= lastRow
  Set r = Range(prevItem, nextItem.Offset(-1, 0))
  mergeAndAlign r
  Set prevItem = nextItem
  Set nextItem = nextItem.End(xlDown)
Wend

' do the last item:
Set nextItem = Cells(lastRow, 5) ' last valid cell in column E
Set r = Range(prevItem, nextItem)
mergeAndAlign r

End Sub

Run the code from the sheet of interest. Click Alt-F8 to bring up the "macro" dialog - you should see the item "MergeAll" in the list (probably the only one). It will take you from this:

To this:

来源：https://stackoverflow.com/questions/16300327/macro-for-merging-cells