samwang

¦^´_ 1# oak0723-1

­É¥Î§Aªº­ì¨Ó¼gªºµ{¦¡¤p­×§ï¤@¤U¦p¤U¡A½Ð´ú¸Õ¬Ý¬Ý¡AÁÂÁÂ

Sub test()
Dim Arr, Drr, Brr(), Crr(), T, XMax, XMin, R%, C%, i&
Tm = Timer
With Sheets("¸ê®Æ®w")
    R = .[b6].End(4).Row
    C = .Cells(5, Columns.Count).End(1).Column
    Arr = .Range(.[b6], .Cells(R, 2))
    Drr = .Range(.[i6], .Cells(R, C))
End With
With Sheets("¤ñ¹ï")
    .[b6].Resize(UBound(Arr)) = Arr
    ReDim Brr(1 To UBound(Arr), 1 To UBound(Drr, 2))
    ReDim Crr(1 To UBound(Arr), 1 To 1)
    C = .Cells(3, Columns.Count).End(1).Column
    Arr = .Range(.[i3], .Cells(4, C))
    For i = 1 To UBound(Drr)
        For j = 1 To UBound(Arr, 2)
            T = Drr(i, j): XMin = Arr(1, j): XMax = Arr(2, j)
            If XMin = "" Or XMax = "" Then Brr(i, j) = "": GoTo 99
            If T < XMin Or T > XMax Then
                Brr(i, j) = 0
            ElseIf T >= XMin Or T <= XMax Then
                 Brr(i, j) = 1: Crr(i, 1) = Crr(i, 1) + 1
            End If
99:     Next j
    Next i
    .Range("h6").Resize(UBound(Crr)) = Crr
    .Range("i6").Resize(UBound(Brr), UBound(Brr, 2)) = Brr
End With
MsgBox Timer - Tm
End Sub

samwang

¦^´_  samwang


­Y·Q°w¹ïhÄd¤º¼Æ­È°µ¤@­Ó±Æ¦W
¤½¦¡¦p  =IF(H6="",0,SUMPRODUCT(($H$6H$500000>=H6 ...
oak0723-1 µoªí©ó 2022-6-5 23:21

·s¼W¬õ¦r¦p¤U¡A½Ð´ú¸Õ¬Ý¬Ý¡AÁÂÁÂ
Set xD = CreateObject("Scripting.Dictionary")
...
...
...
     .Range("h6").Resize(UBound(Crr)) = Crr
    .Range("i6").Resize(UBound(Brr), UBound(Brr, 2)) = Brr

'±Æ¦W
    With .Range(.[h6], .[h6].End(4))
        Arr = .Value
        .Sort Key1:=.Item(1), Order1:=2, Header:=2
        Brr = .Value: .Value = Arr
    End With
    For i = 1 To UBound(Brr)
        T = Brr(i, 1): If Not xD.Exists(T) Then n = n + 1: xD(T) = n
    Next
    For i = 1 To UBound(Arr): Arr(i, 1) = xD(Arr(i, 1)): Next
    .[g6].Resize(UBound(Arr)) = Arr
End With