0

所以我有一个包含 6 组数据的工作表，每组有 6 列数据。在六个数据集中的每一个中，我只想提取那些具有匹配集数的数据。例如，

001 ------ 003 ------ 002 ------ 003 ------ 003 ------ 003 ------
002 ------ 004 ------ 003 ------ 006 ------ 004 ------ 005 ------
003 ------ 005 ------ 006 ------ 007 ------ 009 ------ 013 ------

这是六组数据。此排序宏仅对每组中的第一列感兴趣。这里，每个集合共享行“003-----”。我想编写一个宏来删除任何与其他行不匹配的行。有没有一个宏可以解决这个问题，让我只剩下 003 -----？

我一直在写一个循环宏，上面写着“如果 Rng (A1) > Rng.Offset(,6) AND Rng > Rng.Offset(,12)... 然后（删除相关行）

但是，为此，我需要涵盖所有可用的可能性。我还缺少另一种更明显的方法吗？

谢谢，

4

1 回答 1

0

此宏循环Sheet1并输出工作表中所有相同的行Output。

Sub DeleteNonMatch()
    Dim i As Double
    Dim NotFound As Boolean
    Dim Inp As Worksheet, Out As Worksheet
    Dim r2 As Range, r3 As Range, r4 As Range, r5 As Range, r6 As Range

    'Defines the sheets
    Set Inp = ActiveWorkbook.Sheets("Sheet1") 'Sheet with original dat
    Set Out = ActiveWorkbook.Sheets("Output") 'Output sheet

    'Defines the searchable ranges input sheet
    Set r2 = Inp.Range(Inp.Range("G2").Address & ":" & Inp.Cells(Rows.Count, 7).End(xlUp).Address)
    Set r3 = Inp.Range(Inp.Range("M2").Address & ":" & Inp.Cells(Rows.Count, 13).End(xlUp).Address)
    Set r4 = Inp.Range(Inp.Range("S2").Address & ":" & Inp.Cells(Rows.Count, 19).End(xlUp).Address)
    Set r5 = Inp.Range(Inp.Range("Y2").Address & ":" & Inp.Cells(Rows.Count, 25).End(xlUp).Address)
    Set r6 = Inp.Range(Inp.Range("AE2").Address & ":" & Inp.Cells(Rows.Count, 31).End(xlUp).Address)

    'Sets headers in output sheet
    With Out.Range("A1")
        .Offset(0, 0).Value = Inp.Range("A1").Value
        .Offset(0, 1).Value = Inp.Range("G1").Value
        .Offset(0, 2).Value = Inp.Range("M1").Value
        .Offset(0, 3).Value = Inp.Range("S1").Value
        .Offset(0, 4).Value = Inp.Range("Y1").Value
        .Offset(0, 5).Value = Inp.Range("AE1").Value
    End With

    'Prints identical groups to output sheet
    For i = 2 To Inp.Cells(Rows.Count, 1).End(xlUp).Row Step 1
        NotFound = False

        If r2.Find(Inp.Cells(i, 1).Value, , , xlWhole) Is Nothing Then NotFound = True
        If r3.Find(Inp.Cells(i, 1).Value, , , xlWhole) Is Nothing Then NotFound = True
        If r4.Find(Inp.Cells(i, 1).Value, , , xlWhole) Is Nothing Then NotFound = True
        If r5.Find(Inp.Cells(i, 1).Value, , , xlWhole) Is Nothing Then NotFound = True
        If r6.Find(Inp.Cells(i, 1).Value, , , xlWhole) Is Nothing Then NotFound = True

        If NotFound = False Then
            With Out.Cells(Out.Cells(Rows.Count, 1).End(xlUp).Row + 1, 1)
                .Offset(0, 0).Value = Inp.Cells(i, 1).Value
                .Offset(0, 1).Value = Inp.Cells(i, 1).Value
                .Offset(0, 2).Value = Inp.Cells(i, 1).Value
                .Offset(0, 3).Value = Inp.Cells(i, 1).Value
                .Offset(0, 4).Value = Inp.Cells(i, 1).Value
                .Offset(0, 5).Value = Inp.Cells(i, 1).Value
            End With
        End If
    Next i
End Sub
于 2013-11-12T21:44:15.870 回答