¤j¶q¸ê®Æ¾ã²z

oak0723-1

¦U¦ì¦n
¦pªþ¥ó¤Î¹Ï1»¡©ú
¤u§@ªí"¤ñ¹ï" I3~IN3Àx¦s®æ¤ÎI3~IN3Àx¦s®æ¶ñ¤J¤W­­¼Æ¾Ú¤Î¤U­­¼Æ¾Ú
¤ñ¹ï¤u§@ªí"¸ê®Æ®w"¤¤¦U¦C¼Æ¾Ú¬O§_¦ì©ó¤W¤U­­¼Æ¾Ú¤¤
­Y¦b¤W¤U­­¼Æ¾Ú¤¤(§t¤W¤U­­)Åã¥Ü1
­Y¼Æ¾Ú¤j©ó¤W­­­È©Î¤p©ó¤U­­­È«hÅã¥Ü0
­Y¤W¤U­­¼Æ¾Ú¨ä¤¤1­Ó¬°ªÅ¥Õ,´N¤£¶i¦æ¤ñ¹ï
¨Ã±N¦U¦Cµ²ªG¦X­p

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

lpk187

Sub ¤ñ¹ï()
Dim Brr() As Variant
Dim Arr() As Variant
Dim Crr()
Tm = Timer
Brr = Worksheets("¤ñ¹ï").Range("I3:IN4").Value
Arr = Worksheets("¸ê®Æ®w").[I6:IN6].Value
ReDim Crr(1 To UBound(Arr, 2), 1 To 1)
n = 1
For Each s In Arr
    If s >= Brr(1, n) And s <= Brr(2, n) Then
        Crr(n, 1) = 1
    ElseIf Brr(1, n) = "" Or Brr(2, n) = "" Then
        Crr(n, 1) = ""
    Else
        Crr(n, 1) = 0
    End If
    n = n + 1
Next
MsgBox Timer - Tm
End Sub

singo1232001

¦^´_ 1# oak0723-1

Sub ¤ñ¹ïdb()
T = Timer
Set s = Sheets("¤ñ¹ï")
rw = s.Cells(Rows.Count, "i").End(3).Row
  If rw <= 5 Then rw = 5
   s.Range("h5:in" & rw).ClearContents
    ar = s.[I3:IN5]
   
br = Sheets("¸ê®Æ®w").Range("H5:IN" & Sheets("¸ê®Æ®w").Cells(Rows.Count, "i").End(3).Row)
For i = 1 To UBound(br): br(i, 1) = 0: Next
  For i = 1 To UBound(br, 2): br(1, i) = 0: Next
      
For i = 1 To UBound(ar, 2)
k = i + 1
  If ar(1, i) <> "" Or ar(2, i) <> "" Then
      For j = 2 To UBound(br)
        If ar(1, i) <= br(j, k) Then
         If br(j, k) <= ar(2, i) Then
          br(1, k) = br(1, k) + 1
           br(j, 1) = br(j, 1) + 1
            br(j, k) = 1
         Else
          br(j, k) = 0
         End If
        Else
          br(j, k) = 0
        End If
      Next
  Else
    For j = 2 To UBound(br): br(j, k) = "": Next
  End If
Next

br(1, 1) = "¦X­p"
s.[h5].Resize(UBound(br), UBound(ar, 2) + 1) = br
  MsgBox Format(Timer - T, "0.0") & "¬í"
End Sub


Àu¤Æ¹L ©È§A¶q¹L¤j

­ã´£³¡ªL

Sub TEST_A1()
Dim Arr, Brr, Crr, R&, C%, V(3)
With Sheets("¸ê®Æ®w")
     Arr = Range(.Cells(Rows.Count, 2).End(3), .Cells(5, Columns.Count).End(1)(2))
     R = UBound(Arr): C = UBound(Arr, 2)
End With
Brr = Sheets("¤ñ¹ï").[b3].Resize(2, C)
ReDim Crr(1 To R, 1 To C)
For j = 8 To C
    V(1) = Brr(1, j): V(2) = Brr(2, j)
    If V(1) = "" Or V(2) = "" Then GoTo j01
    For i = 1 To R
        If j = 8 Then Crr(i, 1) = Arr(i, 1)
        V(3) = Arr(i, j): If V(3) = "" Then GoTo i01
        V(0) = (V(3) >= V(1)) * (V(3) <= V(2))
        Crr(i, j) = V(0)
        Crr(i, 7) = Crr(i, 7) + V(0)
i01: Next i
j01: Next j
Sheets("¤ñ¹ï").[b6].Resize(R, C) = Crr
End Sub

oak0723-1

¦^´_ 2# samwang [/b

·P®¦
ÁÂÁÂ

oak0723-1

¦^´_ 3# lpk187


    ·P®¦
ÁÂÁÂ

oak0723-1

¦^´_ 4# singo1232001


    ·P®¦
ÁÂÁÂ

oak0723-1

¦^´_ 2# samwang


­Y·Q°w¹ïhÄd¤º¼Æ­È°µ¤@­Ó±Æ¦W
¤½¦¡¦p  =IF(H6="",0,SUMPRODUCT(($H$6:$H$500000>=H6)*(1/COUNTIF(H$6:H$500000,H$6:H$500000))))
À³¸Ó¦p¦ó?

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