Question

我面临的问题是，我已经进入了一个有用的结构化Excel模型的报告。

我的问题是此报告中的单元格已合并，现在我想将它们取消合并以便更轻松地处理信息。

我尝试使用宏录制器录制内容，但我不确定如何在工作表中的每个单元格上自动执行此操作。

我想让输出看起来像那样：

这是我录制的部分：

Sub Macro1()
    Range("A2:A3").Select
    With Selection
        .HorizontalAlignment = xlGeneral
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = True
    End With
    Selection.UnMerge
    Range("A2").Select
    Selection.AutoFill Destination:=Range("A2:A3")
    Range("A2:A3").Select
End Sub

有关如何重写此宏以自动进行合并和粘贴的任何建议吗？

感谢您的回复！

更新

我尝试使用这个选择，但是，我目前面临的问题是不知道如何获得下一个单元格：

Sub split()
'
'Dim C As Double
'Dim R As Double
Dim Rng As Range

'select cells
Set Rng = Selection

'C = Rng
'R = 10
For Each cell In Rng
'starts in row 2 and A -> cell 2,1 is the first cell or A2
cell.Select
    With Selection
        .HorizontalAlignment = xlGeneral
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = True
    End With
    Selection.UnMerge
    'Cells(R + 1, C) = Cells(R, C)
    If cell.Value = "" Then MsgBox ("Finished splitting and copying!"): End
 '   If C = 7 Then C = 0: R = R + 2
Next cell

End Sub

Answer 1

如果您要更改的数据位于a到g列上，并且您从第2行开始并假设所有单元格都不为空

试试这段代码：

Sub split()
'
Dim C As Double
Dim R As Double

C = 1
R = 2
For C = 1 To 7

Cells(R, C).Select
    With Selection
        .HorizontalAlignment = xlGeneral
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = True
    End With
    Selection.UnMerge
    Cells(R + 1, C) = Cells(R, C)
    If Cells(R, C).Value = "" Then MsgBox ("PROJECT ENDED"): End
    If C = 7 Then C = 0: R = R + 2
    Next C

    End Sub

请在运行宏之前保存数据。你无法撤消。

Answer 2

   Sub Macro1()

    NbRows = Sheets("Feuil1").UsedRange.Rows.Count - 1
    NbCols = 9 ' If it doesn't change

   Range("A2:I11").Copy Destination:= _
        Range("K2")
   Range("K:S").MergeCells = False ' remove merge

    For i = 2 To NbRows ' Number of rows
        For j = 11 To NbCols + NbCols ' Number of cols
            If Cells(i, j) = "" Then
                Cells(i, j) = Cells(i - 1, j).Value
            End If
        Next j
    Next i
End Sub

我的代码将数据从第一个表复制粘贴到单元格“K2”（如示例所示）。然后，您删除将留下一些空白的合并。您要做的是如果单元格（i，1）为空，那么您只需使用上面的数据（单元格（i-1,1））

使用vba取消合并并粘贴细胞

2 个答案: