Question

enter image description here我有一个表，其中包含列和行的合并单元格。我想在合并列的同时取消合并“仅”行。考虑下面的表格片段。在所附的图片中：“合同

enter image description here

For y = 1 To lRow
        p = 1
        c = y
        d = 1
        z = lRow + y
        t = Cells(y, 1).Value
        For x = 1 To t
        Cells(z, p).Value = Cells(c, d).Value
        Cells(c, d).Select
    '      Debug.Print
        Selection.End(xlToRight).Select
        c = ActiveCell.Row
        d = ActiveCell.Column
              p = p + 1
        Next

        Next

Sub ColorMergedCells()
Dim c As Range
Dim startcolumn, endcolumn, startrow, endrow As Long
For Each c In ActiveSheet.UsedRange
If c.MergeCells And c.MergeArea.Rows.Count >= 2 Then
c.Interior.ColorIndex = 28
With c.MergeArea.Rows
                .UnMerge
'                .Formula = c.Formula
End With
'
'startcolumn = ActiveCell.Column
'endcolumn = Selection.Columns.Count + startcolumn - 1
'startrow = ActiveCell.Row
'endrow = Selection.Rows.Count + startrow - 1 

End If
Next
End Sub

Answer 1

没关系。我解决了眼前的问题。发布是否有帮助。

Sub ColorMergedCells()
Dim c As Range
Dim startcolumn, endcolumn, startrow, endrow As Long
For Each c In ActiveSheet.UsedRange
If c.MergeCells And c.MergeArea.Rows.Count >= 2 Then
c.Interior.ColorIndex = 28
startcolumn = c.Column
endcolumn = c.MergeArea.Columns.Count + startcolumn - 1
startrow = c.Row
endrow = c.MergeArea.Rows.Count + startrow - 1
With c.MergeArea.Rows
                .UnMerge
                .Formula = c.Formula
End With

For J = startrow To endrow
    Application.DisplayAlerts = False
    Range(Cells(J, startcolumn), Cells(J, endcolumn)).Merge
    Application.DisplayAlerts = True
Next

如果结束下一个结束

Answer 2

根据您的需求快照，我编写了一个非常简单的代码，看起来似乎很粗糙，但是我一直保持这种方式，以便您可以根据实际数据调整其各种元素。我拍摄的样本数据和获得的结果显示在下面粘贴的快照中，然后是代码。

Sub Merge_unmerge()
    Dim wb As Workbook
    Dim ws As Worksheet
    Dim rng As Range
    Dim cell As Range
    Dim LastRow As Long
    Dim LastCol As Long
    Set wb = ThisWorkbook
    Set ws = wb.Sheets(1)

    With ws
    LastRow = .Cells(.Rows.Count, "B").End(xlUp).Row
    LastCol = .Cells(1, .Columns.Count).End(xlToLeft).Column
    End With
    Set rng = ws.Range("A1:D" & LastRow)
    For Each cell In rng
        cell.UnMerge
    Next cell
    For i = 2 To LastRow
        If Range("A" & i) = "" Then
            Range("A" & i).Value = Range("A" & i - 1).Value
        End If
    Next i
    For i = 2 To LastRow
        If Range("D" & i) = "" Then
           Range("D" & i).Value = Range("D" & i - 1).Value
        End If
    Next i
    For i = 1 To LastRow Step 2
        Range("B" & i & ":C" & i).Merge
        Range("B" & i & ":C" & i).HorizontalAlignment = xlCenter
    Next i
End Sub

如何取消合并行而不合并列

2 个答案: