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

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

将第3行与使用Range.CurrentRegion property和Range.Resize / Range.Offset属性从A1辐射出的数据块中最后一个使用的行隔离后，使用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

取出＆＃34; On Error Resume Next＆＃34;这是隐藏任何错误的可靠方法..

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

4 个答案: