[已解决]分类过滤问题

mate33

分类过滤问题

最佳答案

月排行榜 / 总排行榜

上清宫主

2017-7-19 11:04

以字为单位写的：
Sub test()
Dim ar1(), ar2()
s$ = [d1].Value
ar1 = [f1:f24].Value
ReDim ar2(1 To UBound(ar1), 1 To 1)
For Each stmp In ar1
    stmp2$ = Replace(stmp, " ", "")
    t% = 1
    Do While Len(stmp2)
        If InStr(s, Left(stmp2, 1)) < 1 Then
           t = 0
           stmp2 = ""
        Else
           stmp2 = Replace(stmp2, Left(stmp2, 1), "")
        End If
    Loop
    If t Then
       r = r% + 1
       ar2(r, 1) = stmp
    End If
Next
If r Then [l1].Resize(r, 1) = ar2
End Sub

跳转到最佳答案楼层

上清宫主

是以词为单位还是以字为单位？你说的是字，可例好象是以词

上清宫主

以字为单位写的：
Sub test()
Dim ar1(), ar2()
s$ = [d1].Value
ar1 = [f1:f24].Value
ReDim ar2(1 To UBound(ar1), 1 To 1)
For Each stmp In ar1
    stmp2$ = Replace(stmp, " ", "")
    t% = 1
    Do While Len(stmp2)
        If InStr(s, Left(stmp2, 1)) < 1 Then
           t = 0
           stmp2 = ""
        Else
           stmp2 = Replace(stmp2, Left(stmp2, 1), "")
        End If
    Loop
    If t Then
       r = r% + 1
       ar2(r, 1) = stmp
    End If
Next
If r Then [l1].Resize(r, 1) = ar2
End Sub