楼主
liuguansky |
Q：如何依条件区域的多个条件，在号码的源数据中挑选中符合条件的号码来作为参考？
A：用如下代码可以实现：
全部过滤条件代码：
- Sub justtest1()
- Dim arr, dic, arre, i&, j&, k&, str1$
- Set dic = CreateObject("scripting.dictionary")
- Application.ScreenUpdating = False
- Set rng = [d2:h2] '设置条件区域
- If Application.CountA(rng) = 0 Then
- MsgBox "没有相应条件": Exit Sub
- Else: arr = [d2:h2].Value
- arre = Cells(3, 2).CurrentRegion.Value
- For i = 1 To 5
- With Cells(3, 3 + i)
- If .Offset(1, 0) <> "" Then
- arr = .Resize(.End(4).Row - 2, 1).Value
- For j = 1 To UBound(arre, 1)
- str1 = Mid(arre(j, 1), i, 3)
- For k = 1 To UBound(arr, 1)
- If InStr(1, str1, Mid(arr(k, 1), 1, 1)) > 0 And InStr(1, str1, Mid(arr(k, 1), 2, 1)) > 0 Then
- If Not dic.exists(arre(j, 1)) Then dic.Add arre(j, 1), "": Exit For
- End If
- Next k
- Next j
- End If
- End With
- Next i
- If dic.Count = 0 Then
- MsgBox "条件区域下无内容或者找不到满足条件区域的记录"
- Else: Cells(1, "j") = dic.Count & "注"
- Range("j3:j" & Rows.Count).ClearContents
- Cells(3, "j").Resize(dic.Count, 1) = Application.Transpose(dic.keys)
- End If
- End If
- Application.ScreenUpdating = True
- Set dic = Nothing
- End Sub
子条件参数过程代码：
- Sub justtest(ByVal rng As Range)
- Dim arr, i&, arre, arrt(), str1$, s%, j&, k&
- If rng.Offset(1, 0) = "" Then
- MsgBox "没有相应条件": Exit Sub
- Else: arr = rng.Offset(1, 0).Resize(rng.End(4).Row - 2, 1).Value
- arre = Cells(3, 2).CurrentRegion.Value
- s = CInt(Mid(rng.Value, 1, 1))
- For i = 1 To UBound(arre, 1)
- str1 = Mid(arre(i, 1), s, 3)
- For j = 1 To UBound(arr, 1)
- If InStr(1, str1, Mid(arr(j, 1), 1, 1)) > 0 And InStr(1, str1, Mid(arr(j, 1), 2, 1)) > 0 Then
- k = k + 1
- ReDim Preserve arrt(1 To 1, 1 To k)
- arrt(1, k) = arre(i, 1): Exit For
- End If
- Next j
- Next i
- rng.Offset(-1, 7) = k & "注"
- rng.Offset(1, 7).Resize(Rows.Count - 2, 1).ClearContents
- rng.Offset(1, 7).Resize(k, 1) = Application.Transpose(arrt)
- End If
- End Sub
各单击事件代码：
- Sub test1()
- Call justtest([d2])
- End Sub
- Sub test2()
- Call justtest([e2])
- End Sub
- Sub test3()
- Call justtest([f2])
- End Sub
- Sub test4()
- Call justtest([g2])
- End Sub
- Sub test5()
- Call justtest([h2])
- End Sub
具体示例文件如下：
|