Question

我需要合并并集中超过7,000多行。众多列中有3列将具有可以合并的数据。我无法删除行。我在下面拿了一个小片段，希望能证明这一点。

我使用了这个我发现合并A行的宏。它运行得很好。问题是B列和C列的合并方式不同。我需要根据A列的合并方式进行合并。 A列是独一无二的，它永远不会重复。 B列和C列可能重复，因此合并必须基于A列。

用于合并A列的代码：

Sub MergeSameCell()
    'Updateby20131127
    Dim Rng As Range, xCell As Range
    Dim xRows As Integer
    xTitleId = "KutoolsforExcel"
    Set WorkRng = Application.Selection
    Set WorkRng = Application.InputBox("Range", xTitleId, WorkRng.Address, Type:=8)
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    xRows = WorkRng.Rows.Count
    For Each Rng In WorkRng.Columns
        For i = 1 To xRows - 1
            For j = i + 1 To xRows
                If Rng.Cells(i, 1).Value <> Rng.Cells(j, 1).Value Then
                    Exit For
                End If
            Next
            WorkRng.Parent.Range(Rng.Cells(i, 1), Rng.Cells(j - 1, 1)).Merge
            i = j - 1
        Next
    Next
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
End Sub

这允许我合并A列中的唯一代码（超过7000行）。我需要的下一件事是根据列A的合并将两列合并到它的右边。

示例：我需要B栏和B栏。 C将基于A列合并。我无法执行上面列出的合并宏，因为列B中的'50'跨列A（01,02,03）合并。相反，无论下一组的值是什么，我都需要按顺序合并它们。

我拥有什么：

我需要什么：

任何帮助将不胜感激！

Answer 1

我确定了答案。我将在此发布，以防其他人面临此问题。我调整了原始代码并将其保存在宏中。在进行任何排序之前，选择A列的所有行，然后按F5运行....

Sub MergeSameCell()
'Updateby20131127
Dim Rng As Range, xCell As Range
Dim xRows As Integer
xTitleId = "Multiple Merge & Center"
Set WorkRng = Application.Selection
Set WorkRng = Application.InputBox("Range", xTitleId, WorkRng.Address, 
Type:=8)
Application.ScreenUpdating = False
Application.DisplayAlerts = False
xRows = WorkRng.Rows.Count
For Each Rng In WorkRng.Columns
    For i = 1 To xRows - 1
        For j = i + 1 To xRows
            If Rng.Cells(i, 1).Value <> Rng.Cells(j, 1).Value Then
                Exit For
            ElseIf Rng.Cells(i, 1).Value = "" Then
                Exit For
            End If
        Next
        WorkRng.Parent.Range(Rng.Cells(i, 1), Rng.Cells(j - 1, 1)).Merge
        WorkRng.Parent.Range(Rng.Cells(i, 2), Rng.Cells(j - 1, 2)).Merge
        WorkRng.Parent.Range(Rng.Cells(i, 3), Rng.Cells(j - 1, 3)).Merge
        i = j - 1
    Next
Next
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub

基于其他合并的Excel宏合并单元

1 个答案: