Question

我有一张列出数据的表格如下：

|  A   |   B  |
|11111 |AAAAA |
|11111 |AAAAA |
|11111 |AAAAA |
|      |      |
|22222 |AAAAA |
|22222 |BBBBB |
|22222 |AAAAA |
|      |      |
|33333 |AAAAA |
|33333 |CCCCC |
|33333 |AAAAA |
|33333 |BBBBB |

原始数据不会被空行分割。我想将数据分成几组，所以只要列A中的值发生变化，我就使用以下宏来添加一个空白行：

Sub InsertBlankRowWhenValueChanges()

Dim Rng As Range
Dim WorkRng As Range
On Error Resume Next
xTitleId = "Select Range"
    Set WorkRng = Application.Selection
    Set WorkRng = Application.InputBox("Range", xTitleId, WorkRng.Address, Type:=8)

Application.ScreenUpdating = False
    For i = WorkRng.Rows.Count To 2 Step -1
        If WorkRng.Cells(i, 1).Value <> WorkRng.Cells(i - 1, 1).Value Then
        WorkRng.Cells(i, 1).EntireRow.Insert
        End If
Next
Application.ScreenUpdating = True
End Sub

我需要以某种方式只保留B列中有变化的数据集。如果B列中的所有数据行都匹配，则可以删除整个集合。

示例：

REMOVE

|11111 |AAAAA |
|11111 |AAAAA |
|11111 |AAAAA |

请

|22222 |AAAAA |
|22222 |BBBBB |
|22222 |AAAAA |

无论如何，这可以做到吗？

提前致谢。

Answer 1

看起来你重写了你的问题，现在更有意义了......假设你的数据在启动时看起来如下，数据从第1行开始（没有列标题）：

|11111 |AAAAA|
|11111 |AAAAA|
|11111 |AAAAA|
|11111 |AAAAA|
|22222 |AAAAA|
|22222 |BBBBB|
|22222 |AAAAA|
|33333 |AAAAA|
|33333 |CCCCC|
|33333 |AAAAA|
|33333 |BBBBB|

以下方法可行：

Sub decideOnYourOwnNameForThis()

endRow = Range("A1").End(xlDown).Row

'setup formulas
Range("C2").Formula = "=IF(A2=A1,IF(B2<>B1,1,0), 0)"

'select the first formula row and copy
Range("C2").Select
Selection.Copy

'paste in the formulas
Range("C2:C" & endRow).Select
Selection.PasteSpecial Paste:=xlPasteFormulas

'destroy the forumulas
Range("C2:C" & endRow).Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues

'fill up an array of col A values that you'd like to keep
Dim myArray() As String
aa = 1

For i = 2 To endRow
    If Cells(i, 3) = 1 Then
        ReDim Preserve myArray(1 To aa) As String
        myArray(aa) = Cells(i, 1)
        aa = aa + 1
    End If
Next i


'work backward and delete any row where col A is not contained in the array
For i = endRow To 1 Step -1

    boolContained = False
    For j = LBound(myArray) To UBound(myArray)
        If Cells(i, 1) = myArray(j) Then
            boolContained = True
            Exit For
        End If
    Next j

    If Not boolContained Then
        Rows(i & ":" & i).Select
        Selection.Delete Shift:=xlUp
    End If

Next i

'remove the column if you don't want it
Columns("C:C").Select
Selection.Delete Shift:=xlToLeft

End Sub

最后，如果你想要休息，你可以运行你的分割器代码，你可以在上面的End Sub之前嵌入它：

Call InsertBlankRowWhenValueChanges

删除匹配的数据集

1 个答案: