我想在Excel上执行一个简单的任务，但是VBA代码变得非常长

因此，我有一个包含6组数据的工作表，每个工作表包含6列数据。在这六个数据集中的每一个数据集中，我只想找出那些具有匹配集合号的数据。比如说,

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

这是六组数据。在这个排序宏中，每个集合中只有第一列感兴趣。在这里，每个集合共享一行“003-----”。我想写一个宏，删除任何和其他行不匹配的行。是否有一个宏可以对其进行排序，而只留给我一个宏

我一直在写一个循环宏，它说“如果Rng（A1）>Rng.Offset（，6）和Rng>Rng.Offset（，12）…那么（删除相关行）

然而，对于这一点，我需要涵盖所有可用的可能性。是否还有其他更明显的方法我遗漏了

---

谢谢，

此宏循环通过

工作表1

，并输出

输出

工作表中所有相同的行

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

---

我认为你很接近，但误解了问题所在。这些数据都在一张工作表上，六组是问题中列出的六个分组列。我想删除[00x------]的每个“组”，直到只剩下几行相同的“组”“.在这种情况下，我只剩下003------003------003------003------003------003------这有意义吗？我明白了。我已经更改了代码，希望这可以帮助你。谢谢更新！宏正在运行，但除了输出表上打印的标题外，我没有看到任何其他情况。我在这里更好地解释了这个问题，如果这有助于澄清一些事情的话，我假设你的六列数据中有列a，B，…，F。也许情况并非如此？是的！我们现在越来越近了。具有相同值的单元格将粘贴到另一张图纸上，但我也需要每组中的其他单元格。有关示例，请参见此链接。当BC0000数字在一个特定的集合中相同时，我也要复制五个相邻的单元格。我想这是我需要对你的代码做的一个小改动，但是你能告诉我从哪里开始吗？我是VBA的初学者。。。谢谢