Question

我想基于特定列中的信息，针对多个列自动按列合并单元格。

根据初始图像，堆栈值将确定编号。要合并的颜色，堆栈和大小列的行数，如结果屏幕截图所示。

我在下面找到了此代码，但我不知道如何使其适应我的要求。（我是代码新手，正在学习）

Dim srw As Long, frw As Variant
With Worksheets("Sheet1")
    With Intersect(.Columns(3), .UsedRange)
        srw = 0
        Do While srw < .Rows.Count
            frw = .Cells(srw + 1, 1).Value
            If Not IsError(frw) Then
                .Cells(srw + 1, 1).Resize(frw, 1).Offset(0, -1).Merge
                srw = srw + frw
            Else
                srw = .Cells(Rows.Count, 1).End(xlUp).Row
            End If
        Loop
    End With
End With

首字母缩写：

结果：

Answer 1

尝试此代码

Sub Test()
Dim x, r As Long, c As Long

Application.ScreenUpdating = False
    With Worksheets("Sheet1")
        For r = 2 To .Cells(Rows.Count, 1).End(xlUp).Row
            x = .Cells(r, 3).Value
            If IsNumeric(x) And x > 1 Then
                For c = 2 To 4
                    .Cells(r, c).Resize(x).Merge
                Next c
            End If
        Next r
    End With
Application.ScreenUpdating = True
End Sub

Answer 2

根据需要更改工作表名称和范围，然后尝试：

Option Explicit

Sub Test()

    Dim LastRow As Long
    Dim i As Long
    Dim Number_Of_Rows As Long
    Dim wsTest As Worksheet

    With wsTest
        LastRow = .Range("A" & Rows.Count).End(xlUp).Row
        For i = 2 To LastRow
            If .Range("C" & i).Value > 1 Then
                Number_Of_Rows = .Range("C" & i).Value
                With .Range("B" & .Range("C" & i).Row & ":B" & .Range("C" & i).Row + (Number_Of_Rows - 1))
                    .HorizontalAlignment = xlCenter
                    .VerticalAlignment = xlCenter
                    .MergeCells = True
                End With
                With .Range("C" & .Range("C" & i).Row & ":C" & .Range("C" & i).Row + (Number_Of_Rows - 1))
                    .HorizontalAlignment = xlCenter
                    .VerticalAlignment = xlCenter
                    .MergeCells = True
                End With
                With .Range("D" & .Range("C" & i).Row & ":D" & .Range("C" & i).Row + (Number_Of_Rows - 1))
                    .HorizontalAlignment = xlCenter
                    .VerticalAlignment = xlCenter
                    .MergeCells = True
                End With
            ElseIf .Range("C" & i).Value <> "" Then
                With .Range("B" & i & ":D" & i)
                    .HorizontalAlignment = xlCenter
                    .VerticalAlignment = xlCenter
                End With
            End If
        Next i
    End With

End Sub

根据单元格值合并多列中的单元格

2 个答案: