samwang

¦^´_ 1# ziv976688


Sub test()
Dim Arr, xD, T%, i&, j&, Tm
Tm = Timer
Set xD = CreateObject("Scripting.Dictionary")
R = Columns("M:DF").Find("*", , , , , 2).Row
Arr = Range("M1:DF" & R)
For j = 1 To UBound(Arr, 2) Step 2
    For i = 2 To UBound(Arr)
        T = Arr(i, j): If T = 0 Then GoTo 98
        xD(T & "/1") = xD(T & "/1") + 1
        xD(T & "/2") = xD(T & "/2") + Arr(i, j + 1)
    Next i
98: Next j
Arr = Range([C1], [B65536].End(3))
For i = 2 To UBound(Arr)
    For j = 1 To 2: Arr(i - 1, j) = xD(Arr(i, 1) & "/" & j): Next
Next
[c2].Resize(UBound(Arr) - 1, 2) = Arr
MsgBox Timer - Tm
End Sub

samwang

¦^´_ 6# ziv976688


§AªºBÄ檺¼Æ¦r1~49 ¤£¨£¤F¡A©Ò¥H¾É­P¨º­Ó°ÝÃD¡AÁÂÁÂ

samwang

¦^´_  ML089
¦^´_  samwang


¤U¦C·s¼W»Ý¨Dªº»yªk~Àµ½Ð¤G¦ì¤j¤jÄ~Äò½ç±Ð¡CÁÂÁ !
.[A2] = ((M1F1) ...
ziv976688 µoªí©ó 2021-8-22 01:47

½Ð´ú¸Õ¬Ý¬Ý¡AÁÂÁÂ
Sub test()
Dim Arr, Brr(1 To 7), Crr, xD, T%, i&, j&
Set xD = CreateObject("Scripting.Dictionary")
With Sheets("Sheet1")
T = .[A1]
Arr = Range([DATA!h1], [DATA!a65536].End(3))
For i = 2 To UBound(Arr)
    If Arr(i, 1) = T Then
        For j = 2 To 8: n = n + 1: Brr(n) = Arr(i, j): Next
    End If
Next
.[A4].Resize(7) = Application.Transpose(Brr)
.[A2] = (.Cells(1, 256).End(xlToLeft).Column - 12) / 2
Arr = .Range(.[B2], .[e65536].End(3))
ReDim Crr(1 To UBound(Arr), 1 To 5)
For i = 1 To UBound(Arr)
    If Arr(i, 3) > 0 Then Arr(i, 4) = Arr(i, 3) / Arr(i, 2)
    Crr(i, 1) = Arr(i, 2): Crr(i, 2) = Arr(i, 2)
    Crr(i, 3) = Arr(i, 1): Crr(i, 4) = Arr(i, 3)
    Crr(i, 5) = Arr(i, 4)
Next
.[B2].Resize(UBound(Arr), 4) = Arr
With Range("g2").Resize(UBound(Crr), 5)
    .Value = Crr
    .Sort key1:=.Item(1), Order1:=2, Header:=xlNo
    Crr = .Value
End With
T = Application.Max(.Range("g2:g" & UBound(Crr)))
For i = 1 To UBound(Crr)
    Crr(i, 1) = T - Crr(i, 1) + 1
Next
[H2].Resize(UBound(Crr), 1) = Crr
End With
End Sub

samwang

¦^´_ 9# ziv976688

½Ð¦Û¦æ·s¼W¦p¤U¡A¦]¬°·íµL¸ê®Æ¸É¤W0¡AÁÂÁÂ
   
For i = 2 To UBound(Arr)
      For j = 1 To 2: Arr(i - 1, j) = xD(Arr(i, 1) & "/" & j): Next
      If xD(Arr(i, 1) & "/1") = "" Then Arr(i - 1, 1) = 0: Arr(i - 1, 2) = 0 '­n·s¼W
Next
  .[C2].Resize(UBound(Arr) - 1, 2) = Arr  'C&DÄæ

samwang

¦^´_  samwang
·PÁ±zªº«ü¾É^^



¤£¦n·N«ä¡A"·s¼W»Ý¨D"ªºµ{¦¡½X~§Ú©ñ¸mªº¦ì¦C~¤£ª¾¹D¬O­þ¸Ì¦³»~¸m ...
ziv976688 µoªí©ó 2021-8-22 10:28

¤£¦n·N«ä¡AArr¨Ó·½ªº¸ê®Æb¡Be­n¹ï½Õ¤@¤U§Y¥i¡AÁÂÁÂ
Arr = .Range(.[e2], .[b65536].End(3))

samwang

¦^´_ 15# ziv976688

Àx¦s®æ¤ÏÃC¦â¦p¤U¡A½Ð´ú¸Õ¬Ý¬Ý¡AÁÂÁÂ

Sub test()
Dim Arr, Brr
With Sheets("Sheet1")
    Arr = .[a1:a10]
    R = .Columns("M:V").Find("*", , , , , 2).Row
    Brr = .Range("M1:DF" & R)
    For i = 4 To UBound(Arr)
        If i < UBound(Arr) Then
            .Cells(i, 1).Interior.Color = 65280
            For j = 1 To UBound(Brr, 2) Step 2
            For i2 = 2 To UBound(Brr)
                If Brr(i2, j) = Arr(i, 1) Then
                .Cells(i2, j + 12).Interior.Color = 65280
                End If
            Next i2
            Next j
        Else
            .Cells(i, 1).Interior.Color = 16776960
            For j = 1 To UBound(Brr, 2) Step 2
            For i2 = 2 To UBound(Brr)
                If Brr(i2, j) = Arr(i, 1) Then
                .Cells(i2, j + 12).Interior.Color = 16776960
                End If
            Next i2
            Next j
        End If
    Next
End With
End Sub

samwang

¦^´_  samwang
S¤j¤j : ±z¦n !
¤£¦n·N«ä¡A¯à§_½Ð±z¥t¥~¦A«ü¾É~¥H´M§ä¡÷¨ú¥Nªº¤è¦¡¨Ó§¹¦¨»Ý¨D?
EX1¡G½d³ò ...
ziv976688 µoªí©ó 2021-8-23 00:15

¤£¤Ó¯à²z¸Ñ±zªº·N«ä¡A
´M§ä = .[A4:A9] ¥B¦rÅéÃC¦â=7¸¹ªº¼Æ¦r¡A¨ú¥N¬°4¸¹©³¦â >> ³o¬O¤£¬O©M#16µ{¦¡»Ý¨D¤@¼Ë¶Ü?

samwang

¦^´_ 20# ziv976688

«á¾Ç¤]¬O¾Ç²ß¤¤¡A¨C­Ó¤H¼gªk¤£¤@©w³£¤@¼Ë¡A¥u­n¯à¼g¥X»Ý¨D¥\¯à´N¦n¡A·PÁ¡C