用于合并细胞的宏

时间:2013-04-30 12:48:17

标签: excel excel-vba excel-2007 vba

我在Excel B中有一个带有发票编号的Excel文件,(B2:B14987),在C列中我有项目ID,在D列中我有已售出的值,在E列中我有发票折扣价值。

我需要一个宏来根据发票编号列合并发票折扣值单元格,重复发票编号,因为一张发票中有不同的商品ID。

例如:B1:B3是相同的发票号,E1B1:B3E2:E3中的发票的常用折扣值是空白单元格。所以我希望合并E1:E3,并使用E1中的值。

1 个答案:

答案 0 :(得分:2)

以下代码执行我认为您要求的内容;一如既往,如果我误解了,请澄清问题,我们会到达那里......

在电子表格中创建一个模块,然后粘贴以下代码:

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

运行感兴趣的表格中的代码。单击Alt-F8以显示“宏”对话框 - 您应该在列表中看到项目“MergeAll”(可能是唯一的一个)。它会带你从这里:

original spreadsheet

对此:

spreadsheet after merge