删除匹配的数据集

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

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

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

 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中的所有数据行匹配，整个集合可以被删除。

例：

去掉

 |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 

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

 Call InsertBlankRowWhenValueChanges