ªð¦^¦Cªí ¤W¤@¥DÃD µo©«

[µo°Ý] (¤w¸Ñ¨M)¦p¦ó¦C¥X¬Û¦P³¡ªùªº­û¤u

¥»©«³Ì«á¥Ñ Andy2483 ©ó 2023-3-30 12:59 ½s¿è

¦^´_ 6# Hsieh


    ÁÂÁ½׾Â,ÁÂÁ«e½ú
«á¾ÇÂǦ¹©«½m²ß°}¦C»P¦r¨å,¾Ç²ßªº¤è®×¦p¤U,½Ð¦U¦ì«e½ú«ü±Ð

°õ¦æ«e:


°õ¦æµ²ªG:



Option Explicit
Sub TEST()
Dim Brr, Crr, i&, xR, Y
Set Y = CreateObject("Scripting.Dictionary")
Set xR = Range([B2], Cells(Rows.Count, 1).End(3)): Brr = xR
For i = 1 To UBound(Brr)
   If Y(Brr(i, 1)) = "" Then Y(Brr(i, 1)) = Y.Count
Next
With [K1].Resize(, Y.Count)
   .EntireColumn.ClearContents
   .Value = Y.keys
End With
ReDim Crr(UBound(Brr), 1 To Y.Count)
For i = 1 To UBound(Brr)
   Crr(Y(Brr(i, 1) & "|"), Y(Brr(i, 1))) = Brr(i, 2)
   Y(Brr(i, 1) & "|") = Y(Brr(i, 1) & "|") + 1
Next
[K2].Resize(UBound(Crr), UBound(Crr, 2)) = Crr
Set Y = Nothing: Set xR = Nothing: Erase Brr, Crr
End Sub
¥Î¦æ°Ê¸Ë¸mÂsÄý½×¾Â¾Ç²ß«Ü¤è«K,ÁÂÁ½׾¸gÀç¹Î¶¤
½Ð¤j®a¤@°_¤W½×¾Â¨Ó¥æ¬y

TOP

ÁÂÁ½׾Â,ÁÂÁ¦U¦ì«e½ú
«á¾ÇÂǦ¹©«½m²ß¦r¨å¤¤ªº°}¦C½s¿è,½Ð¦U¦ì«e½ú«ü±Ð

Option Explicit
Sub TEST_2()
Dim Brr, Crr, i&, R&, xR, Y, Z, V, N
Set Y = CreateObject("Scripting.Dictionary")
Set xR = Range([B2], Cells(Rows.Count, 1).End(3)): Brr = xR
R = UBound(Brr): ReDim A(1 To R, 0)
For i = 1 To R
   If Not IsArray(Brr(i, 1)) Then Y(Brr(i, 1)) = A
Next
With [K1].Resize(, Y.Count)
   .EntireColumn.ClearContents: .Value = Y.keys
End With
For i = 1 To R
   Z = Y(Brr(i, 1)): Y(Brr(i, 1) & "|") = Y(Brr(i, 1) & "|") + 1
   Z(Y(Brr(i, 1) & "|"), 0) = Brr(i, 2): Y(Brr(i, 1)) = Z
Next
For Each V In Y.Items
   If IsArray(V) Then N = N + 1: [K2].Item(1, N).Resize(R, 1) = V
Next
Set Y = Nothing: Set xR = Nothing: Erase Brr
End Sub
¥Î¦æ°Ê¸Ë¸mÂsÄý½×¾Â¾Ç²ß«Ü¤è«K,ÁÂÁ½׾¸gÀç¹Î¶¤
½Ð¤j®a¤@°_¤W½×¾Â¨Ó¥æ¬y

TOP

        ÀR«ä¦Û¦b : ¦¨¥\¬OÀuÂIªºµo´§¡A¥¢±Ñ¬O¯ÊÂIªº²Ö¿n¡C
ªð¦^¦Cªí ¤W¤@¥DÃD