Question

我在这张Excel表格中有数千行数据。我试图想出一个宏来在所有列的第二列中合并相同数量的行。但是其他列中的某些值并不相同，因此只合并具有相同值的行。

编辑：此问题不重复。它与先前的question不同，第四列不能合并具有相同值的所有行，因为如果第二列中的顺序行具有相同的值，则它只能合并第四列中的行。这是因为第四列中的所有值都是95％相同。

原件：

期望合并：

Answer 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

Answer 2

试试这个。

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

用于在同一行中合并多列中的行的宏

2 个答案: