一个分类筛选的问题，求大神相助，谢谢

dxvyi · 发表于 2020-4-30 21:30

初学使用EXCEL，好多问题都不会，求大神相助，如图：

3190496160 · 发表于 2020-5-1 11:00

这种问题，似乎不是工作上的问题吧

3190496160 · 发表于 2020-5-1 11:16

Sub test()
Set d = CreateObject("scripting.dictionary")
Set dc = CreateObject("scripting.dictionary")
ar1 = Range("c4:c7")
ar2 = Range("c8:c9")
For i = 1 To UBound(ar1)
d(Trim(ar1(i, 1))) = ""
Next i
For i = 1 To UBound(ar2)
dc(Trim(ar2(i, 1))) = ""
Next i
ar = Range("f2:g12")
For i = 2 To UBound(ar)
n_1 = 0: n_2 = 0
If InStr(ar(i, 2), "、") > 0 Then
      rr = Split(ar(i, 2), "、")
      For s = 0 To UBound(rr)
         If d.exists(Trim(rr(s))) Then
            n_1 = n_1 + 1
         End If
         If dc.exists(Trim(rr(s))) Then
            n_2 = n_2 + 1
         End If
      Next s
ElseIf InStr(ar(i, 2), "、") = 0 Then
         If d.exists(Trim(ar(i, 2))) Then
            n_1 = n_1 + 1
         End If
         If dc.exists(Trim(ar(i, 2))) Then
            n_2 = n_2 + 1
         End If
End If
If n_1 > 0 Then sg = sg + 1
If n_2 > 0 Then yl = yl + 1
If n_1 > 0 And n_2 = 0 Then zysg = zysg + 1
If n_1 = 0 And n_2 > 0 Then zyyl = zyyl + 1
If n_1 > 0 And n_2 > 0 Then sy = sy + 1
Next i
[f16] = sg
[f17] = yl
[f18] = zysg
[f19] = zyyl
[f20] = sy
End Sub

3190496160 · 发表于 2020-5-1 11:17

仅供参考

工作簿2.rar (14.83 KB, 下载次数: 2)

dxvyi · 发表于 2020-5-1 11:39

3190496160 发表于 2020-5-1 11:17
仅供参考

大神，不用VBA，用公式能解决吗

3190496160 · 发表于 2020-5-1 11:42

dxvyi 发表于 2020-5-1 11:39
大神，不用VBA，用公式能解决吗

个人觉得，这种问题，公式是不可能解决的，

dxvyi · 发表于 2020-5-1 12:14

3190496160 发表于 2020-5-1 11:42
个人觉得，这种问题，公式是不可能解决的，

哦，谢谢了

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