VBA删除指定明细

z865593849

Qs18

阿哩木 发表于 2024-10-13 15:40
您好，非常感谢您的帮忙。在Q2:W2的区域只输入张  代码运行后的结果有点不准确，麻烦您可以再帮忙看下吗 ...

Sub qs()
Dim arr, i, brr
With Sheet1
arr = .Range("a3:n" & .Cells(Rows.Count, 1).End(3).Row)
ReDim crr(1 To UBound(arr), 1 To UBound(arr, 2))
brr = .[q2:w2]
For j = 1 To UBound(brr, 2)
    If brr(1, j) <> "" Then
    s = s & "|" & brr(1, j)
    End If
Next
For i = 1 To UBound(arr)
    If InStr(s, arr(i, 2)) = 0 Then
        m = m + 1
        For c = 1 To UBound(arr, 2)
            crr(m, c) = arr(i, c)
        Next
    End If
Next
.Range("a3:n1000") = ""
.Range("a3").Resize(m, UBound(arr, 2)) = crr
End With
End Sub