批量删除符合条件的行

听歌的海

请教下大神帮忙看看这代码哪里不行？我要删除掉cjmc的仓库所在的行，及J列为空的行；一行行判断太卡了，先感谢各位了；



Sub 删除多余行()
Dim d As Object
Set d = CreateObject("scripting.dictionary")
Dim arr As Variant, brr As Variant
nextrow = Sheets(1).Range("a2").End(xlDown).Row
nextcol = Sheets(1).Range("IV2").End(xlToLeft).Column
cjmc = Array("固定资产仓", "生产现场仓", "生产周转仓", "板材仓", "厂外仓", "物料仓", "合*计", "车间半成品周转仓", "车间仓", "来料加工仓")
arr = [a2].CurrentRegion
ReDim brr(1 To nextrow, 1 To nextcol)

For x = 1 To UBound(arr)
For y = 0 To UBound(cjmc)
If Cells(x, 2).Value <> cjmc(y) Or Cells(x, 10) <> "" Then
s = arr(x, 1) & "|" & arr(x, 2) & "|" & arr(x, 3) & "|" & arr(x, 4) & "|" & arr(x, _
     5) & "|" & arr(x, 6) & "|" & arr(x, 7) & "|" & arr(x, 8) & "|" & arr(x, 9) & "|" & arr(x, 10)
t = d(s)
If t = "" Then
k = k + 1
d(s) = k
t = k
brr(k, 1) = arr(x, 1)
brr(k, 2) = arr(x, 2)
brr(k, 3) = arr(x, 3)
brr(k, 4) = arr(x, 4)
brr(k, 5) = arr(x, 5)
brr(k, 6) = arr(x, 6)
brr(k, 7) = arr(x, 7)
brr(k, 8) = arr(x, 8)
brr(k, 9) = arr(x, 9)
brr(k, 10) = arr(x, 10)

End If

End If
Next
Next




With ActiveSheet
    .[a2].CurrentRegion.Offset(1) = Empty
    .[a2].Resize(k, UBound(brr, 2)) = brr
End With


End Sub

3190496160

目前的代码似乎是借鉴了我的一些思路，但是，似乎用得不得法，看你目前的代码，看不出来你究竟想要干嘛，如果仅仅是为了删除行，就没有必要这般复杂的吧，

gwjkkkkk

删除掉cjmc的仓库所在的行，这个没看懂？？？

mmwwdd

一个二条语句就能解决的问题，楼主是不是有点小题大做了，筛选-删除

听歌的海

gwjkkkkk 发表于 2022-12-26 21:30
删除掉cjmc的仓库所在的行，这个没看懂？？？

是我没有表述清楚，附件B列的有些仓库和期末数量为0的不需要，比如："固定资产仓", "生产现场仓", "生产周转仓"等，去掉多余数据是其中一个步骤，麻烦大神再帮忙看看；

听歌的海

3190496160 发表于 2022-12-26 18:50
目前的代码似乎是借鉴了我的一些思路，但是，似乎用得不得法，看你目前的代码，看不出来你究竟想要干嘛，如 ...

是我没有表述清楚，需求很简单，附件B列的有些仓库和期末数量为0的不需要，比如："固定资产仓", "生产现场仓", "生产周转仓"等，去掉多余数据是其中一个步骤，麻烦大神再帮忙看看；

ykcbf1100

楼主整复杂了，这个应该不用字典吧。

听歌的海

ykcbf1100 发表于 2022-12-27 08:51
楼主整复杂了，这个应该不用字典吧。

你好，我测试时，当InStr(str, arr(x, 2)) 大于0时，仍会继续执行if内的语句，这是为何？

ykcbf1100

听歌的海 发表于 2022-12-27 10:23
你好，我测试时，当InStr(str, arr(x, 2)) 大于0时，仍会继续执行if内的语句，这是为何？

那应该是arr(x,10)不为空的情况。

3190496160

Sub 删除多余行()
Dim d As Object
Set d = CreateObject("scripting.dictionary")
Dim arr As Variant
Dim rng As Range
rr = Array("固定资产仓", "生产现场仓", "生产周转仓", "板材仓", "厂外仓", "物料仓", "合*计", "车间半成品周转仓", "车间仓", "来料加工仓")
For i = 0 To UBound(rr)
    d(rr(i)) = ""
Next i
With ActiveSheet
    r = .Cells(Rows.Count, 1).End(xlUp).Row
    arr = .Range("a1:j" & r)
    For x = 3 To UBound(arr)
        If d.exists(VBA.Trim(arr(x, 2))) Or VBA.Trim(arr(x, 10)) = "" Then
            If rng Is Nothing Then
                Set rng = .Rows(x)
            Else
                Set rng = Union(rng, .Rows(x))
            End If
        End If
    Next x
    If Not rng Is Nothing Then rng.Delete
End With
MsgBox "ok!"
End Sub