Vba 删除同一行中另一列的值为0的重复项

我有一个工作表，有大约30k行数据和20列。B列中的许多值都是重复的，我想删除这些重复的值。我的问题是，即使列b可能是重复的，但其余列中的行数据不一定是重复的，因此，只有当列b中的值是重复的且列M中的值为0时，我们才删除该行，这一点很重要

对于工作表中的每一行（工作表名称为Test），是否有方法执行此操作？我想它涉及到每个…，但我没有太多的经验，也没有找到任何其他宏可以完成这项任务。如果您需要我详细说明我正在努力实现的目标，请告诉我

---

谢谢你的帮助

除非您需要经常重复相同的过程，否则您也可以筛选符合条件的行并手动删除它们

如果数据是基于B列排序的，则可以在M列中添加一个公式，将B列中每个单元格的值与上面和下面的值进行比较，以确定重复项

下面的公式将检查单元格B是否与上面或下面的值匹配，以及列M=0是否匹配，结果为真/假。

---

=ANDROB2=B1，B2=B3，M2=0这是VBA中的一种简单方法，可以像查询表格一样查询电子表格。您必须根据您的具体情况调整RunQuery方法，因为我不知道您的列名

这假设如下：

工作表的布局类似于表格，第1行为列名，下面为数据 在运行此代码之前，您已保存工作簿 在我的特定工作簿中，我有一个标记为Category的列，一个标记为Types的列，并且我添加了一个名为DeleteMe的列

'Adapt RunQuery for your particular needs
Sub RunQuery()
    'Change this SQL statement to reflect your particular need
    SQL = "SELECT [Category], [Types] FROM %table(0)% GROUP BY [Category], [Types] HAVING Count(*) > 1"

    'Change "Sheet2" to your sheet name
    Set rs = QuerySheet(SQL, Sheet2)

    Do While Not rs.EOF
        SQL = "UPDATE %table(0)% SET [DeleteMe]='x' WHERE [Category]='" & rs!Category & "' AND [Types]='" & rs!Types & "'"
        'Again, change Sheet2 to your sheet name
        QuerySheet SQL, Sheet2
        rs.MoveNext
    Loop
End Sub

'You don't need to change this function
Function QuerySheet(sSQL, ParamArray Worksheets())
    Dim oSh
    Dim sConn, n

    On Error GoTo QuerySheet_Err
    Set QuerySheet = CreateObject("ADODB.Recordset")
    sConn = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & Worksheets(0).Parent.FullName & ";Extended Properties=""Excel 8.0;HDR=Yes"";"

    n = 0
    For Each oSh In Worksheets
        sSQL = Replace(sSQL, "%table(" & n & ")%", "[" & oSh.Name & "$]")
        n = n + 1
    Next
    QuerySheet.Open sSQL, sConn
    Exit Function

QuerySheet_Err:
    MsgBox "Error in QuerySheet(): " & Err.Description
    End
End Function

该代码使用x更新DeleteMe列。现在，您可以按DeleteMe排序，并删除行或编写一个简单的VBA语句来执行此操作

您的RunQuery方法需要看起来更像这样，将B列和M列替换为工作表标题行中的字段名称：

    ...

    'Change this SQL statement to reflect your particular need
    SQL = "SELECT [column B] FROM %table(0)% WHERE [column M] = 0 GROUP BY [column B] HAVING Count(*) > 1"

    'Change "Sheet2" to your sheet name
    Set rs = QuerySheet(SQL, Sheet2)

    Do While Not rs.EOF
        SQL = "UPDATE %table(0)% SET [DeleteMe]='x' " & _
           " WHERE " & _
           IIf(IsNull(rs![column B]), _
               " [column B] IS NULL", _
               " [column B]='" & rs![column B] & "' ") & _
           " AND [column M]=0"

        'Again, change Sheet2 to your sheet name
        QuerySheet SQL, Sheet2

    ...

---

注意：当您将工作表的名称从Sheet1更改为其他名称时，有时会出现调试错误。。。这个问题还没有解决。但这对于快速的脏查询非常有效。

您可以在没有VBA的情况下尝试：

添加带有公式的列

=B1&IF(M1=0,"",RAND()*9999999)

如果M1=0，这将创建一个唯一的条目

将新列复制粘贴到值

根据新列执行常规的“删除重复项”例程

---

删除新列

对M列上的数据进行降序排序，然后对数据进行降序排序► 删除B列上的重复项。删除重复项始终从较高的行号中删除重复项。感谢您的建议。一个问题是M列中也有一些值是空的，因此它们被排序到底部；但是，如果列L中的值为0，则可能仍需要删除这些值。有没有办法用VBA完成这项任务？谢谢，我会试一试的！看到您对另一个答案的评论-更新了第二个代码段以处理B列中的空值