提取序号问题

kandhong88

老师：
   我请教的是提取序号问题。
   工作表"数据区"e2:e8为序号区；f2:i8数据区，其中："03040506070911121314"代表数字3、4、5、6、7、9、11、12、13、14。现请用VBA实现如下功能：
   一是如果f2包含C9的个数为4至7，则在工作表"结果区"C2处显示序号000，否则为空；
   二是如果g2包含C9的个数为4至7，则在工作表"结果区"d2处显示序号000，否则为空；
   三是如果H2包含C9的个数为4至7，则在工作表"结果区"E2处显示序号000，否则为空；
   四是如果I2包含C9的个数为4至7，则在工作表"结果区"F2处显示序号000，否则为空。
    序号提取.rar (320.45 KB, 下载次数: 3)

2024-11-22 16:38 上传

点击文件名下载附件

   
   

   

xbox1210

练习练习，不知道理解的对不对。

gwjkkkkk

Option Explicit
Sub TEST6()
    Dim ar, i&, j&, k&, n&, dic As Object, strTxt$
   
    Application.ScreenUpdating = False
    Set dic = CreateObject("Scripting.Dictionary")
   
    strTxt = [C9].Value
    For j = 1 To Len(strTxt) Step 2
        dic(Mid(strTxt, j, 2)) = Empty
    Next j
   
    ar = Worksheets(1).Range("F2:I8").Value
    For i = 1 To UBound(ar)
        For j = 1 To UBound(ar, 2)
            strTxt = ar(i, j): ar(i, j) = Empty: n = 0
            For k = 1 To Len(strTxt) Step 2
                If dic.exists(Mid(strTxt, k, 2)) Then n = n + 1
            Next k
            If InStr("4567", n) Then ar(i, j) = "000"
        Next j
    Next i
   
    With Worksheets(2)
        .UsedRange.ClearContents
        .[C2].Resize(UBound(ar), UBound(ar, 2)) = ar
        .Activate
    End With
    Set dic = Nothing
    Application.ScreenUpdating = True
    Beep
End Sub

gwjkkkkk

..........

longwin

附件供参考...