请高手师傅们帮忙看下咋删除资料

qiongmei6

我想求得一个代码，在导入文件里头，他根据删除商家表格里头a列的名字，删除“导入文件”表格里头a列相应名字同一行的数据，谢谢各位高手师傅的帮忙

gwjkkkkk

ykcbf1100

附件供参考。。。

ykcbf1100

1. Sub ykcbf()   '//2025.12.8
   
2.     ApplicationSettings False
   
3.     arr = Sheets("删除商家").UsedRange.Value
   
4.     For Each k In arr
   
5.         ptt = ptt & "|" & k
   
6.     Next
   
7.     ptt = Mid(ptt, 2)
   
8.     Set ws = ActiveSheet
   
9.     arr = ws.UsedRange.Value
   
10.     u = UBound(arr, 2)
    
11.     ReDim brr(1 To UBound(arr), 1 To UBound(arr, 2))
    
12.     Dim tm: tm = Timer
    
13.     For i = 2 To UBound(arr)
    
14.         If styes(arr(i, 1), ptt) = True Then GoTo 100
    
15.         m = m + 1
    
16.         For j = 1 To u
    
17.             brr(m, j) = arr(i, j)
    
18.         Next
    
19. 100:
    
20.     Next
    
21.     ws.[a2].Resize(m, u) = brr
    
22.     ws.UsedRange.Offset(m + 1).Clear
    
23.     ApplicationSettings True
    
24.     MsgBox "共用时：" & Format(Timer - tm, "0.000") & " 秒"
    
25. End Sub
    
26. 
    
27. Function styes(st, ptt) As Boolean
    
28.     Dim arr() As String, i As Long
    
29.     If ptt = "" Or Trim(st & "") = "" Then Exit Function
    
30.     arr = Split(ptt, "|")
    
31.     For i = LBound(arr) To UBound(arr)
    
32.         If InStr(1, st, arr(i), vbTextCompare) > 0 Then
    
33.             styes = True
    
34.             Exit Function
    
35.         End If
    
36.     Next
    
37. End Function
    
38. 
    
39. Private Sub ApplicationSettings(ByVal Reset As Boolean)   '//纯office环境
    
40.     With Application
    
41.         .ScreenUpdating = Reset: .DisplayAlerts = Reset
    
42.         .Calculation = IIf(Reset, xlCalculationAutomatic, xlCalculationManual)
    
43.         .AskToUpdateLinks = Reset: .EnableEvents = Reset: .EnableAnimations = Reset
    
44.     End With
    
45. End Sub
    

复制代码

gwjkkkkk

请参考附件。。。