我想按列合并相似的单元格,截至目前我正在使用此宏
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
这是我想完成的
最佳答案
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)
,并且我们将每个单元格与其最左边的单元格进行比较;进行整个操作的原因是,默认情况下,合并单元格的值保留在其左上方的单元格中。合并的单元格的其他单元格没有值。
这就是为什么我们总是将合并后的单元格与“左”邻居进行比较的原因。
这些是
OnEnd
和OnStart
,以简化操作。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/