Excel Visual Basic 宏用于合并选定区域中的单元格

Question

我有一个 excel 电子表格，我想将每个单元格与其中的值合并到它下面的每个空单元格，直到该列中的下一个单元格具有值。

目前我有这个：

Sub mergemainbody()    
    lrow = ActiveSheet.UsedRange.Rows.Count - 2        
    On Error Resume Next  
    Application.DisplayAlerts = False  
    For col = 1 To 50  
       For Each ar In Cells(3, col).Resize(lrow).SpecialCells  (xlCellTypeBlanks).Areas  
          ar.Resize(ar.Rows.Count + 1).Offset(-1).Merge  
       Next  
    Next  
 End Sub

这适用于整个工作表，但我希望宏仅适用于选定区域。然而，简单地将For col = 1 to 50 更改为For Each cell In Selection 会使宏看起来什么都不做。

数据示例：

Heading | Heading   | Heading   | Heading   |      
1456262 | 270520    | 574038    | 583059    |    
Words   | --------- | --------- | --------- |  
586048  | --------- | --------- | --------- |        
Words   | 694574    | 856738    | 068438    |    

其中 --- 表示单元格为空。

Answer 1

这是一个粗略的方法，可以根据您的要求合并您的选择。请注意，如果第一个单元格中没有值，这将无法按照您的预期方式工作

Sub MergeDown()
    Dim rng As Range, r As Range
    Dim i As Integer

    Set rng = Selection
    For Each r In rng
        If r.Value <> "" Then
            i = 1
            While r.Offset(i, 0).Value = "" And Not Intersect(r.Offset(i, 0), rng) Is Nothing
                i = i + 1
            Wend
            r.Resize(i, 1).Merge
        End If
    Next r
End Sub

Answer 2

我假设您不想将第二行与标题行合并。

在使用 Range.CurrentRegion property 和 Range.Resize / Range.Offset 属性将数据块中从 A1 向外辐射的第 3 行隔离到最后使用的行之后，将 Range.SpecialCells method 与 xlCellTypeBlanks 一起使用.当您循环浏览 Range.Areas property 时，请在合并前调整大小和偏移量。

Dim c As Long, a As Long
With ActiveSheet
    'work on the block of data radiating out from A1
    With .Cells(1, 1).CurrentRegion
        'move off the header row and first row of data
        With .Resize(.Rows.Count - 2, .Columns.Count).Offset(2, 0)
            'work through the columns
            For c = 1 To .Columns.Count
                'locate the blank cells in groups (aka Areas)
                With .Columns(c).Cells.SpecialCells(xlCellTypeBlanks)
                    'cycle through the areas (blank cell groups)
                    For a = 1 To .Areas.Count
                        'work with each Area in turn
                        With .Areas(a).Cells
                            'resize one row larger and offset one row up
                            .Resize(.Rows.Count + 1, 1).Offset(-1, 0).Merge
                            'optionally center the value in the newly merged cells
                            .VerticalAlignment = xlCenter
                        End With
                    Next a
                End With
            Next c
        End With
    End With
End With

Answer 3

我相信您的问题是从未声明变量，因此 VBA 正在猜测它们是什么。使用此代码，看看是否有任何错误：

Option Explicit
Sub mergemainbody()
Dim selRange As Range
Dim lRow    As Long
Dim ar As Range, col As Range

Set selRange = Selection
lRow = selRange.Rows.Count - 2    ' Why -2?
'On Error Resume Next
Application.DisplayAlerts = False

For Each col In selRange.Columns
    For Each ar In Cells(3, col.Column).Resize(lRow).SpecialCells(xlCellTypeBlanks).Areas
        ar.Resize(ar.Rows.Count + 1).Offset(-1).Merge
    Next
Next col
End Sub

它可能抛出的唯一错误是没有更多SpecialCells(xlCellTypeBLanks)之后的错误，这意味着它成功地运行了所有单元格。

Answer 4

取出“On Error Resume Next”，这是隐藏任何错误的可靠方法..