我在这张Excel表格中有数千行数据。我试图想出一个宏来在所有列的第二列中合并相同数量的行。但是其他列中的某些值并不相同,因此只合并具有相同值的行。
编辑:此问题不重复。它与先前的question不同,第四列不能合并具有相同值的所有行,因为如果第二列中的顺序行具有相同的值,则它只能合并第四列中的行。这是因为第四列中的所有值都是95%相同。
答案 0 :(得分:1)
感谢TylerH提供代码建议。以下是未来参考的调整代码:
Private Sub MergeTheseCellsToMakeSomethingLikeADatabase()
'Crucial Line Below
Application.DisplayAlerts = False
Dim i%
Dim j%
With ThisWorkbook.Sheets("SUMMARY")
For j = 6 To 2 Step -1
For i = .UsedRange.Rows.Count To 2 Step -1
If .Cells(i, 2).Value = .Cells(i - 1, 2).Value And .Cells(i, j).Value = .Cells(i - 1, j).Value Then
.Range(.Cells(i, j), .Cells(i - 1, j)).Merge
'Do this for all rows that are relevant or just have another for loop to cycle
'Through the rows that you want merged
End If
Next
Next
End With
End Sub
答案 1 :(得分:0)
试试这个。
Sub test()
Dim rngDB As Range
With Application
.ScreenUpdating = False
.DisplayAlerts = False
End With
Set rngDB = Range("b2", Range("b" & Rows.Count).End(xlUp))
MergeRange rngDB
With Application
.ScreenUpdating = True
.DisplayAlerts = True
End With
End Sub
Sub MergeRange(rngDB As Range)
Dim rng As Range
Dim rngO As Range, myCell As Range
Dim n As Integer
For Each rng In rngDB
If rng <> "" Then
n = WorksheetFunction.CountIf(rngDB, rng)
Set rngO = rng.Offset(, 1).Resize(n)
MergeRange rngO
For Each myCell In rngO
If myCell <> "" Then
myCell.Resize(WorksheetFunction.CountIf(rngO, myCell)).Merge
End If
Next myCell
rng.Resize(n).Merge
End If
Next rng
End Sub