[已解决]高级筛选

ld89406065 · 发表于 2016-7-6 15:25

请哪位大神帮我按附件的要求做一个程序，万分感谢！

最佳答案

wanao2008

2016-7-6 20:08

本帖最后由 wanao2008 于 2016-7-6 20:11 编辑

请测试：

Sub wanao()
Dim PinX As String, PeiB As String, Arr, pb, Lx As Single, Y As Integer
PinX = Sheet2.[a2]
PeiB = Sheet2.[b2]
Sheet1.Range("a1:d1").Copy Sheet3.Range("a1:d1")
Arr = Sheet1.Range("A1").CurrentRegion
For x = 2 To UBound(Arr)
Lx = Sheet3.Cells(Rows.Count, 1).End(xlUp).Row
If Arr(x, 1) = PinX Then
pb = Split(PeiB, "+")
If UBound(pb) = 2 Then
If Arr(x, 2) = pb(0) & "+" & pb(1) Or Arr(x, 2) = pb(0) & "+" & pb(2) Or Arr(x, 2) = pb(1) & "+" & pb(2) Then Y = 1
End If
If Arr(x, 2) = PeiB Or Y = 1 Then
Lx = Lx + 1
For Y = 1 To 4
Sheet3.Cells(Lx, Y) = Arr(x, Y)
Next
End If
Y = 0
End If
Next
End Sub

复制代码

zyouong · 发表于 2016-7-6 17:03

高级筛选.rar (43.67 KB, 下载次数: 12)

wanao2008 · 发表于 2016-7-6 20:08

本帖最后由 wanao2008 于 2016-7-6 20:11 编辑

请测试：

Sub wanao()
Dim PinX As String, PeiB As String, Arr, pb, Lx As Single, Y As Integer
PinX = Sheet2.[a2]
PeiB = Sheet2.[b2]
Sheet1.Range("a1:d1").Copy Sheet3.Range("a1:d1")
Arr = Sheet1.Range("A1").CurrentRegion
For x = 2 To UBound(Arr)
Lx = Sheet3.Cells(Rows.Count, 1).End(xlUp).Row
If Arr(x, 1) = PinX Then
pb = Split(PeiB, "+")
If UBound(pb) = 2 Then
If Arr(x, 2) = pb(0) & "+" & pb(1) Or Arr(x, 2) = pb(0) & "+" & pb(2) Or Arr(x, 2) = pb(1) & "+" & pb(2) Then Y = 1
End If
If Arr(x, 2) = PeiB Or Y = 1 Then
Lx = Lx + 1
For Y = 1 To 4
Sheet3.Cells(Lx, Y) = Arr(x, Y)
Next
End If
Y = 0
End If
Next
End Sub

复制代码

ld89406065 · 发表于 2016-7-7 09:22

wanao2008 发表于 2016-7-6 20:08
请测试：

谢谢，其他功能都实现了，还有一条没实现就是输入红+黄+黑三种颜色时只能筛选红+黄+黑，不能筛出红+黄、红+黑、黄+黑，请帮我再修改一下，谢谢。

ld89406065 · 发表于 2016-7-7 14:14

可以了，谢谢！

		自动登录	找回密码
密码			注册