两次不同多条件筛选，并且把两次筛选出的结果分别复制(不带格式)递增粘贴

sampsonpon

1、筛选X列为空白，且R列为工作表“LG&AN&WD”里C2:C所有值
2、把筛选出的内容A:W数值式复制粘贴到工作表"Picking List"里A:W(添加式粘贴)
3、再筛选X列为空白，且K列为工作表“LG&AN&WD”里A2:A所有值
4、把筛选出的内容A:W数值式复制粘贴到工作表"Picking List"里A:W(添加式粘贴)
5、恢复成不筛选状态
6、从X列第一个空白开始给X列标记"Y",直到K列空白为止

小凡、、、

这个用筛选反而麻烦了吧，不带格式的话循环判断写入数组反而简单

sampsonpon

小凡、、、 发表于 2024-7-26 16:26
这个用筛选反而麻烦了吧，不带格式的话循环判断写入数组反而简单

不知道啊，只要能得到想要的结果都可以啊

小凡、、、

最后应该是range（a5）写错了，数据位置放错了，改了测试下

Jaofuan

1. Sub jaofuan()
   
2.     Set d1 = CreateObject("scripting.dictionary")
   
3.     Set d2 = CreateObject("scripting.dictionary")
   
4.     Set st = Sheet4
   
5.     Row = st.Cells(Rows.Count, "a").End(xlUp).Row
   
6.     For i = 2 To Row
   
7.         If Not d1.Exists(st.Cells(i, "a")) Then d1.Add st.Cells(i, "a").Value, i
   
8.     Next
   
9.     Row = st.Cells(Rows.Count, "c").End(xlUp).Row
   
10.     For i = 2 To Row
    
11.         If Not d2.Exists(st.Cells(i, "c")) Then d2.Add st.Cells(i, "c").Value, i
    
12.     Next
    
13.     Row = Sheet2.Cells(Rows.Count, "k").End(xlUp).Row
    
14.     arr = Sheet2.Range("a2:x" & Row)
    
15.     Dim brr(1 To 500, 1 To 23)
    
16.     For i = 1 To UBound(arr)
    
17.         If IsEmpty(arr(i, 24)) Then
    
18.             If d2.Exists(arr(i, 18)) Or d1.Exists(arr(i, 11)) Then
    
19.                 k = k + 1
    
20.                 For j = 1 To UBound(brr, 2)
    
21.                     brr(k, j) = arr(i, j)
    
22.                 Next
    
23.                 Cells(i, "x") = "Y"
    
24.             End If
    
25.         End If
    
26.     Next
    
27.     Sheet1.[a5].Resize(500, 23) = brr
    
28. End Sub
    

复制代码

Jaofuan

yanglinzi

1. Sub 筛选()
   
2. Dim arr, brr, i, j, r, s, d
   
3. Set d = CreateObject("scripting.dictionary")
   
4. With Sheet4
   
5.     arr = .UsedRange
   
6.     For i = 2 To UBound(arr)
   
7.         For j = 1 To UBound(arr, 2) Step 2
   
8.             If arr(i, j) <> "" Then
   
9.                 sa = arr(i, j)
   
10.                 d(sa) = ""
    
11.             End If
    
12.         Next
    
13.     Next
    
14. End With
    
15. With Sheet2
    
16.     r = .Cells(Rows.Count, 1).End(xlUp).Row
    
17.     c = .Cells(1, Columns.Count).End(xlToLeft).Column
    
18.     arr = .Range("a1").Resize(r, c)
    
19. End With
    
20. ReDim brr(1 To UBound(arr), 1 To UBound(arr, 2))
    
21. For i = 2 To UBound(arr)
    
22.     sb = arr(i, 18)
    
23.     sc = arr(i, 11)
    
24.     If sc <> Empty Then
    
25.         arr(i, 24) = "Y"
    
26.     End If
    
27.     If d.exists(sb) Then
    
28.         n = n + 1
    
29.         For j = 1 To UBound(arr, 2)
    
30.             brr(n, j) = arr(i, j)
    
31.         Next
    
32.     End If
    
33.     If d.exists(sc) Then
    
34.         n = n + 1
    
35.         For j = 1 To UBound(arr, 2)
    
36.             brr(n, j) = arr(i, j)
    
37.         Next
    
38.     End If
    
39. Next
    
40. Sheet2.[a1].Resize(r, 24) = arr
    
41. Sheet1.[a5].Resize(n, 24) = brr
    
42. End Sub
    

复制代码

yanglinzi

请测试。。。。

sampsonpon

小凡、、、 发表于 2024-7-26 16:53
最后应该是range（a5）写错了，数据位置放错了，改了测试下

太棒了！好简洁！


If Not IsError(Application.Match(wso.Cells(i, "R"), r, 0)) Or _
   Not IsError(Application.Match(wso.Cells(i, "K"), k, 0)) Then 'KR两列有一列符合条件

改了一下这里，就完全是我想要的结果了。

不过还有个地方请帮我改正一下：
这里不是最后在这儿写值后然后给第24列写值"Y",
而是返回"Org1"工作表里给X列写值"Y"(从X列第一个空白处开始给X列标记"Y",直到K列空白为止)

sampsonpon

小凡、、、 发表于 2024-7-26 16:53
最后应该是range（a5）写错了，数据位置放错了，改了测试下

老师，请问这样表达为什么不能取到这一行值呢？