求按x4到aq4里显示的个位数

王拥军

求按x4到aq4里显示的个位数）.rar (119.06 KB, 下载次数: 12)

2024-6-20 20:33 上传

点击文件名下载附件

dambcer

手头剪刀布，你先出，分析啥啊

gwjkkkkk

Option Explicit
Sub TEST2()
    Dim ar, br, cr(), i&, j&, r&, n&, dic As Object, vKey
   
    Application.ScreenUpdating = False
   
    r = Cells(Rows.Count, "A").End(xlUp).Row
    ar = Range("A1:V" & r).Value
   
    Range("X5:AQ" & Rows.Count).ClearContents
    br = [X3:AR4].Resize(UBound(ar)): r = 2
   
    Set dic = CreateObject("Scripting.Dictionary")
    For j = 1 To UBound(br, 2) - 1
         If Len(br(2, j)) Then dic(j) = br(2, j)
    Next j
        
    For i = 3 To UBound(ar)
        n = 0: Erase cr
        For Each vKey In dic.keys
            If CStr(Right(ar(i, vKey + 2), 1)) = dic(vKey) Then
                n = n + 1
                ReDim Preserve cr(1 To n)
                cr(n) = vKey
            End If
        Next
        If n > 4 Then
            r = r + 1
            For j = 1 To UBound(cr)
                br(r, cr(j)) = ar(i, cr(j) + 2)
            Next j
        End If
    Next i
   
    [X3].Resize(r, UBound(br, 2) - 1) = br
    Application.ScreenUpdating = True
    Beep
End Sub

gwjkkkkk

请参考附件

王拥军

gwjkkkkk 发表于 2024-6-22 19:19
请参考附件

所查询的数据要显示在显示区，数据是动态的