vba 用于合并单元格的宏
声明：本页面是StackOverFlow热门问题的中英对照翻译，遵循CC BY-SA 4.0协议，如果您需要使用它，必须同样遵循CC BY-SA许可，注明原文地址和作者信息，同时你必须将它归于原作者（不是我）：StackOverFlow
原文地址: http://stackoverflow.com/questions/16300327/
Warning: these are provided under cc-by-sa 4.0 license. You are free to use/share it, But you must attribute it to the original authors (not me):
StackOverFlow
Macro for merging cells
提问by davidb
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.
我有一个 Excel 文件，在 B 列中有发票编号，( B2:B14987)，在 CI 列中有项目 ID，在 DI 列中有销售价值，在 EI 列中有发票折扣值。
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.
我需要一个宏来根据发票编号列合并发票折扣值单元格，发票编号重复，因为一张发票中有不同的项目 ID。
For example: B1:B3are the same invoice number, E1is the common discount value for the invoices which are in B1:B3, E2:E3are blank cells. So I want E1:E3to be merged, with the value that was in E1.
例如：B1:B3是相同的发票编号，E1是发票的共同折扣值，是在B1:B3，E2:E3是空白单元格。所以我想E1:E3与E1.
回答by Floris
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:
运行感兴趣的工作表中的代码。单击 Alt-F8 以显示“宏”对话框 - 您应该会在列表中看到“MergeAll”项（可能是唯一一项）。它将带你从这里：
To this:
对此：
