我想按列合并相似的单元格,截至目前我正在使用此宏

Sub MergeSimilarCells()

    Set myRange = Range("A1:Z300")

CheckAgain:
    For Each cell In myRange
        If cell.Value = cell.Offset(0, 1).Value And Not IsEmpty(cell) Then
            Range(cell, cell.Offset(0, 1)).Merge
            cell.VerticalAlignment = xlCenter
            cell.HorizontalAlignment = xlCenter
            GoTo CheckAgain
        End If
    Next

End Sub


我的问题是数百行40-50列,这需要永远。
我很确定For Loop可以在那帮我,但我不够熟练,无法弄清楚

我知道以下代码是错误的,但我迷路了

Sub SimilarCells()
  Set myRange = Range("A1:G4")
    Dim count As Integer

CheckAgain:
    count = 1

    For Each cell In myRange
        If cell.Value = cell.Offset(0, 1).Value And Not IsEmpty(cell) Then
            count = count + 1

        ElseIf cell.Value <> cell.Offset(0, 1).Value Then
            Range(cell, cell.Offset(0, -count)).Merge
        End If
    Next

End Sub


excel - VBA合并相似的单元格-LMLPHP

这是我想完成的

excel - VBA合并相似的单元格-LMLPHP

最佳答案

Sub MergeMe()

    Dim wks As Worksheet: Set wks = Worksheets(1)
    Dim myRange As Range: Set myRange = wks.Range("B2:H5")
    Dim myCell As Range
    Dim myCell2 As Range

    Dim firstColumn As Long: firstColumn = myRange.Columns(1).column + 1
    Dim lastColumn As Long: lastColumn = firstColumn + myRange.Columns.Count - 1
    Dim firstRow As Long: firstRow = myRange.Rows(1).row
    Dim lastRow As Long: lastRow = firstRow + myRange.Rows.Count - 1
    Dim column As Long
    Dim row As Long

    OnStart

    For column = lastColumn To firstColumn Step -1
        For row = lastRow To firstRow Step -1
            Set myCell = wks.Cells(row, column)
            Set myCell2 = myCell.Offset(0, -1)
            If myCell.Value = myCell2.Value Then
                With wks.Range(myCell, myCell2)
                    .Merge
                    .VerticalAlignment = xlCenter
                    .HorizontalAlignment = xlCenter
                End With
            End If
        Next row
    Next column

    OnEnd

End Sub


此代码中有很多技巧:


我们需要获取第一列和最后一列和最后一行;
那么我们应该从最后一个单元格(右下)循环到第一个单元格(左上);
我们不应该输入第一列,因为我们使用的是.Offset(0,-1),并且我们将每个单元格与其最左边的单元格进行比较;
进行整个操作的原因是,默认情况下,合并单元格的值保留在其左上方的单元格中。合并的单元格的其他单元格没有值。
这就是为什么我们总是将合并后的单元格与“左”邻居进行比较的原因。


这些是OnEndOnStart,以简化操作。

Public Sub OnEnd()

    Application.ScreenUpdating = True
    Application.EnableEvents = True
    Application.AskToUpdateLinks = True
    Application.DisplayAlerts = True
    Application.Calculation = xlAutomatic
    ThisWorkbook.Date1904 = False
    Application.StatusBar = False

End Sub

Public Sub OnStart()

    Application.ScreenUpdating = False
    Application.EnableEvents = False
    Application.AskToUpdateLinks = False
    Application.DisplayAlerts = False
    Application.Calculation = xlAutomatic
    ThisWorkbook.Date1904 = False
    ActiveWindow.View = xlNormalView

End Sub

关于excel - VBA合并相似的单元格,我们在Stack Overflow上找到一个类似的问题:https://stackoverflow.com/questions/58615586/

10-08 21:48
查看更多