Question

我是VBA的新手，但我正在尽力将细胞与宏结合起来我需要的确切内容非常复杂：如果它们具有相同的字符串，则将行中的单元格组合在一起（并且加号是在合并的单元格中放置边框）

请参见此处的图示示例：

我已尝试使用此代码，但效果不佳，特别是将一个单元格与之前已合并的单元格合并时。

你可以给我一些帮助吗？

提前致谢！

Sub Main()

    Dim i As Long
    Dim j As Long

    For i = 1 To 5
        For j = 1 To 15
            If StrComp(Cells(i, j), Cells(i, j + 1), vbTextCompare) = 0 Then
                Range(Cells(i, j), Cells(i, j + 1)).Merge
                SendKeys "~"
            End If
        Next j
    Next i

End Sub

Answer 1

或者您可以尝试这样的事情......

Sub MergeSimilarCells()
Dim lr As Long, lc As Long, i As Long, j As Long
lr = Cells(Rows.Count, 1).End(xlUp).Row
Application.DisplayAlerts = False
For i = 1 To lr
    lc = Cells(i, Columns.Count).End(xlToLeft).Column
    For j = 1 To lc
        If Cells(i, j).MergeArea.Cells(1).Value = Cells(i, j + 1).MergeArea.Cells(1).Value Then 'Or Cells(i, j) = Cells(i, j - 1) Then
            Range(Cells(i, j).MergeArea, Cells(i, j + 1)).Merge
        End If
    Next j
Next i
Range("A1").CurrentRegion.Borders.Color = vbBlack
End Sub

Answer 2

Sub Main()

    Dim i As Long
    Dim j As Long
    Dim rws As Long
    Dim clms As Long
    Dim strt As Range
    Dim endr As Range

    With ActiveSheet
        rws = .Cells(.Rows.Count, 1).End(xlUp).Row 'Find last row
        clms = .Cells(1, Columns.Count).End(xlToLeft).Column 'Find last column

        For i = 1 To rws 'iterate rows
            Set strt = .Cells(i, 1) 'set start of range
            For j = 2 To clms + 1 'iterate columns plus one
                If strt.Value <> .Cells(i, j).Value Then 'check for change
                    Set endr = .Cells(i, j - 1) ' if change set end of range
                    Application.DisplayAlerts = False
                    .Range(strt, endr).Merge 'merge start to end
                    Application.DisplayAlerts = True
                    Set strt = .Cells(i, j) 'set new start range on new cell
                End If
            Next j
        Next i
        With .Range(.Cells(1, 1), .Cells(rws, clms)).Borders 'put border on entire range
            .LineStyle = xlContinuous
            .Weight = xlThin
        End With
    End With

End Sub

如何在Excel中将类似的单元格与VBA合并

2 个答案: