如何在Excel中合并具有相同数据的相邻列？

debugcn 发表于 Dev

腾发

我发现这个宏可以合并相邻的行。我想编辑它以合并相邻的列而不是行。

原始宏（来自上面的链接）产生左侧的结果。我编辑的宏产生了右侧的结果。

我尝试在代码中切换所有行/列的引用，但它只是在第二次或第三次出现后合并列。我的循环有问题吗？

Sub MergeSimilarCol()
'Updateby20131127
Dim Rng As Range, xCell As Range
'Dim xRows As Integer
Dim xCols As Integer
xTitleId = "MergeSimilarCol"
Set WorkRng = Application.Selection
Set WorkRng = Application.InputBox("Range", xTitleId, WorkRng.Address, Type:=8)
Application.ScreenUpdating = False
Application.DisplayAlerts = False

'xRows = WorkRng.Rows.Count
xCols = WorkRng.Columns.Count

'For Each Rng In WorkRng.Columns
    'For i = 1 To xRows - 1
        'For j = i + 1 To xRows
            'If Rng.Cells(i, 1).Value <> Rng.Cells(j, 1).Value Then
                'Exit For
             'End If
        'Next
        'WorkRng.Parent.Range(Rng.Cells(i, 1), Rng.Cells(j - 1, 1)).Merge
        'i = j - 1
    'Next
'Next

For Each Rng In WorkRng.Rows
    For i = 1 To xCols - 1
        For j = i + 1 To xCols
            If Rng.Cells(i, 1).Value <> Rng.Cells(j, 1).Value Then
                Exit For
            End If
        Next
        WorkRng.Parent.Range(Rng.Cells(1, i), Rng.Cells(1, j - 1)).Merge
        i = j - 1
    Next
Next

Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub

用户4039065

这是一个可能更有意义的替代方法。我会把合并的单元格格式留给你。

Option Explicit

Sub mergeWeeks()
    Dim lc As Long, nc As Long, cr As Long, rng As Range

    Application.DisplayAlerts = False

    With Worksheets("sheet2")
        For cr = 1 To 2
            lc = Application.Match("zzz", .Rows(cr))
            Set rng = .Cells(cr, 1)
            Do While rng.Column < lc
                nc = Application.Match(rng.Value & "z", .Rows(cr))
                rng.Resize(1, nc - rng.Column + 1).Merge
                Set rng = rng.Offset(0, 1)
            Loop
        Next cr
    End With

    Application.DisplayAlerts = True

End Sub

本文收集自互联网，转载请注明来源。

如有侵权，请联系[email protected] 删除。