[µo°Ý] 5.5¬í! ¨D§ó·Ç§ó§Ö! (¼Æ¦rÀx¦s®æ¤À©³¦â¥[Á`)

Andy2483

¦U¦ì«e½ú¦n
1.«á¾ÇÂǦ¹¥DÃDªì²L¾Ç²ß¨ìÀx¦s®æ©³¦âÃC¦â¸òÃC¦â²`²L,ÁÂÁ¦U¦ì«e½ú¦b½×¾Â¤W´£¨Ñ½d¨Ò»P½×­z!·PÁ½׾Â!
2.½Ð±Ð10*100®æ ¼Æ¦rÀx¦s®æ¤À©³¦â¥[Á` ¨D«e½ú«ü¥¿¨Ã«ü¾É
¼Æ¦rÀx¦s®æ¤À©³¦â¥[Á`_20221103.zip (42.79 KB)

¤U¸ü¦¸¼Æ: 6

2022-11-3 11:09

°õ¦æ«e:

¤U¸ü (281.22 KB)

2022-11-3 11:10

10*10000®æªº°õ¦æµ²ªG: 521 ¬í

¤U¸ü (150.21 KB)

2022-11-3 11:11

10*100®æªº°õ¦æµ²ªG: 5.5.¬í

¤U¸ü (132.1 KB)

2022-11-3 11:12

Andy2483

¾Ç²ßÁ`¬O¶^¶^¼²¼²!¶V¹J®À§é¶V«i´±¦V«e!ÁÂÁ«e½ú­Ì«ü¾É!
­ì¥H¬°Âà¸m¦r¨åªºitem:Application.Transpose(Y.ITEMS)¥i¥H¸Ñ¨M!
10*20®æÁÙ¥i¥H¶¶ºZ,¼W¥[¨ì10*100®æ´NµLªkÂà¸m¤F:

¤U¸ü (130.7 KB)

2022-11-3 12:56

µ{¦¡½X¦p¤U:
Option Explicit
Sub ¦r¨å»P°}¦C½m²ß()
Dim Arr, Brr(1), Crr, C, i, Sh, xR As Range, Y, U, R, Tc, TT, N, Q, T
T = Timer
Set Y = CreateObject("Scripting.Dictionary")
Set Sh = Sheets("¾Þ§@ªí")
R = Sh.UsedRange.EntireRow.Rows.Count
C = Sh.UsedRange.EntireColumn.Columns.Count
Set Arr = Range(Sh.[A1], Sh.Cells(R, C))
For Each xR In Arr
   If IsNumeric(xR.Value) = False Or xR.Value = "" Then GoTo 888
   Tc = xR.Interior.Color
   TT = xR.Interior.TintAndShade
   Crr = Y(Tc & "|" & TT)
   If Not IsArray(Crr) Then
      Crr = Brr
   End If
   Crr(0) = Crr(0) + xR.Value
   If Crr(1) = "" Then
      Crr(1) = xR.Value
      Else
         Crr(1) = Crr(1) & "," & xR.Value
   End If
   Y(Tc & "|" & TT) = Crr
   
888
Next
Workbooks.Add
[A1] = "ÃC¦â¡÷": [A2] = "¼Æ¦r¥[Á`¡÷": [A3] = "¡õ¥H¤U¬O©ú²Ó"
[B2].Resize(2, Y.Count) = Application.Transpose(Y.ITEMS)
N = 1
For Each i In Y.KEYS
   N = N + 1
   Cells(1, N).Interior.Color = Val(Split(i, "|")(0))
   Cells(1, N).Interior.TintAndShade = Val(Split(i, "|")(1))
   Q = Split(Cells(3, N), ",")
   Cells(3, N).Resize(UBound(Q) - LBound(Q) + 1, 1) = Application.Transpose(Q)
Next
[A2].CurrentRegion.Value = [A2].CurrentRegion.Value
Cells.Columns.AutoFit
Cells.Borders.LineStyle = 1
MsgBox Timer - T & " ’"
End Sub

Andy2483

²³æ±N½m²ß¤ß±oµù¸Ñ¤@¤U:
Option Explicit
Sub ¦r¨å»P°}¦C½m²ß()
Dim Arr, Brr(1 To 100000, 1 To 1), Crr, C, i, Sh, xR As Range
Dim N&, T, Y, U, R, Tc, Ti, Q, TT
'¡ô«Å§iÅܼÆ
T = Timer
Set Y = CreateObject("Scripting.Dictionary")
'¡ô¥OY¬O¦r¨å
Set Sh = Sheets("¾Þ§@ªí")
'¡ô¥OSh ¬O ¾Þ§@ªí
R = Sh.UsedRange.EntireRow.Rows.Count
'¡ô¥OR ¬O¦³¨Ï¥Îªº¦C¼Æ
C = Sh.UsedRange.EntireColumn.Columns.Count
'¡ô¥OC ¬O¦³¨Ï¥ÎªºÄæ¼Æ
Set Arr = Range(Sh.[A1], Sh.Cells(R, C))
'¡ô¥OArr¬O°}¦C!­Ë¤J¦³¨Ï¥ÎªºÀx¦s®æ­È
For Each xR In Arr
'¡ô³]¶¶°j°é!¥OxR ¬OArr°}¦Cªº¤@­û
   If IsNumeric(xR.Value) = False Or xR.Value = "" Then GoTo 888
   '¡ô¦pªG °}¦C­È¤£¬O¼Æ¦r ©Î °}¦C­È¬OªÅ¦r¤¸! ´N¸õ¨ì 888¦ì¸mÄ~Äò°õ¦æ
   Tc = xR.Interior.Color
   '¡ô¥OTc ¬OÃC¦â
   Ti = xR.Interior.TintAndShade
   '¡ô¥OTi ¬O²`²L
   TT = Tc & "|" & Ti
   '¡ô¥OTT ¬OÃC¦â & "|" & ²`²L ²Õ¦X¦r¦ê
   Crr = Y(TT)
   '¡ô¥OCrr°}¦C¬O ²Õ¦X¦r¦ê¬°keyªº Y¦r¨åitem
   If Not IsArray(Crr) Then
   '¡ô¦pªGCrr ¤£¬O°}¦C
      N = N + 1
      '¡ôÃC¦âºØÃþ²Ö¥[ 1
      Y(TT & "/z") = N
      '¡ô¥O ²Õ¦X¦r¦ê& "/z" ¬°key,ÃC¦âºØÃþ¼Æ¬°item ­Ë¤JY¦r¨å
      Crr = Brr
      '¡ô¥OCrr ¬OBrrªÅ°}¦C
   End If
   Y(TT & "/r") = Y(TT & "/r") + 1
   '¡ô¥O ²Õ¦X¦r¦ê& "/r" ¬°key­Ë¤JY¦r¨å,item²Ö¥[ 1
   Y(TT & "/a") = Y(TT & "/a") + xR.Value
   '¡ô¥O ²Õ¦X¦r¦ê& "/a" ¬°key­Ë¤JY¦r¨å,item²Ö¥[ xRªº­È
   Crr(Y(TT & "/r"), 1) = xR.Value
   '¡ô±N xRªº­È­Ë¤J«ü©wªº Crr°}¦C¦ì¸m
   Y(TT) = Crr
   '¡ô±NCrr­Ë¤JY¦r¨å¤¤
   
888
Next
Workbooks.Add
[A1] = "ÃC¦â¡÷": [A2] = "¼Æ¦r¥[Á`¡÷": [A3] = "¡õ¥H¤U¬O©ú²Ó"
For Each TT In Y.KEYS
'¡ô³]¶¶°j°é!¥O TT¬OY¦r¨åkeys¸Ìªº¤@­û
   If InStr(TT, "/") Then GoTo 666
   '¡ô¦pªG TT¸Ì¦³ "/"²Å¸¹ ! ´N¸õ¨ì 666¦ì¸mÄ~Äò°õ¦æ
   Crr = Y(TT)
   '¡ô§âY¦r¨å¥H TT ¬°keyªº°}¦Citem©I¥s¥X¨Ó
   Cells(1, Y(TT & "/z") + 1).Interior.Color = Val(Split(TT, "|")(0))
   '¡ô¥O²Ä¤@¦CÀx¦s®æ©³¦âÃC¦â¬OY¦r¨å¸Ìitemªº­È
   Cells(1, Y(TT & "/z") + 1).Interior.TintAndShade = Val(Split(TT, "|")(1))
   '¡ô¥O²Ä¤@¦CÀx¦s®æ©³¦âÃC¦â²`²L¬OY¦r¨å¸Ìitemªº­È
   Cells(2, Y(TT & "/z") + 1) = Y(TT & "/a")
   '¡ô¥O²Ä¤G¦CÀx¦s®æ¬OY¦r¨å¸Ìitemªº­È(¥[Á`­È)
   Cells(3, Y(TT & "/z") + 1).Resize(Y(TT & "/r"), 1) = Crr
   '¡ô¥O²Ä¤T¦CÀx¦s®æ³vÄæ¶K¤J¦¬¶°¨ìªº¼Æ¦r
666
Next
Cells.Columns.AutoFit
'¡ô¥þ³¡Äæ¦ì¦Û°Ê½Õ¾ãÄæ¼e
Cells.Borders.LineStyle = 1
'¡ô¥þ³¡Àx¦s®æ®æ½u¬°²Ó¹ê½u
MsgBox Timer - T & " ’"
End Sub

ÁÂÁ«ü¥¿¨Ã«ü¾É!

samwang

¦^´_ 1# Andy2483


Sub test()
Dim Arr, Brr(1 To 10000, 1 To 100), xD, R&, C%, Sh
Dim xR As Range, x%, y$, x1%, j%, crl, T
T = Timer
Set xD = CreateObject("Scripting.Dictionary")
Set Sh = Sheets("¾Þ§@ªí")
R = Sh.UsedRange.EntireRow.Rows.Count
C = Sh.UsedRange.EntireColumn.Columns.Count
Set Arr = Range(Sh.[a1], Sh.Cells(R, C))
For Each xR In Arr
    If IsNumeric(xR.Value) = False Or xR.Value = "" Then GoTo 888
    crl = xR.Interior.Color
    y = 2
    If xD.Exists(crl) Then
        y = xD(crl): x1 = xD(crl & "_C")
        Brr(2, x1) = Brr(2, x1) + xR.Value
        Brr(y + 1, x1) = xR.Value
        xD(crl) = y + 1
    Else
        x = x + 1: Brr(1, x) = crl: Brr(2, x) = xR.Value
        y = y + 1: Brr(y, x) = xR.Value
        xD(crl) = y: xD(crl & "_C") = x
    End If
888: Next
Workbooks.Add
[a1] = "ÃC¦â¡÷": [A2] = "¼Æ¦r¥[Á`¡÷": [A3] = "¡õ¥H¤U¬O©ú²Ó"
[b1].Resize(1000, x) = Brr
For j = 1 To x: Cells(1, j + 1).Interior.Color = Brr(1, j): Next
Range(Cells(1, 2), Cells(1, x + 1)) = ""
Cells.Columns.AutoFit
Cells.Borders.LineStyle = 1
MsgBox Timer - T & " ’"
End Sub

Andy2483

¦^´_ 4# samwang


    ÁÂÁ«e½ú«ü¾É
¶Wµuªº®É¶¡!¼F®`!
¥H¤U¬O°õ¦æµ²ªG»P¤ß±oµù¸Ñ,½Ð«e½ú¦A«ü¾É!
«á¾Ç¹ï¸Ñ¨M°ÝÃDªº±Ò©l³£µLÀYºü!¶Ã¸Õ! ¥é¿ù¤èªk! ¤S¼Ò¥éªº¥|¤£¹³!
¾É­P®Ä²v¤£¹ü! ¦Û¤vªºµù¸Ñ¤]¿ùµù!
ÁÂÁ«ü¾É

²Ä¤@¦C¥¼²M°£®É:

¤U¸ü (99.12 KB)

2022-11-4 10:02

³Ì«áµ²ªG:

¤U¸ü (170.37 KB)

2022-11-4 10:03

Option Explicit
Sub test_samwang()
Dim Arr, Brr(1 To 10000, 1 To 100), xD, R&, C%, Sh
Dim xR As Range, x%, y$, x1%, j%, crl, T
'¡ô«Å§iÅܼÆ!¦h­ÓÅܼƬOµu¾ã¼Æ!¨S¥Îªø¾ã¼Æ!¤£ª¾®Ä²v¬O§_¦³®t?¦A¬ã¨s!
T = Timer
Set xD = CreateObject("Scripting.Dictionary")
'¡ô¥OxD¬O¦r¨å
Set Sh = Sheets("¾Þ§@ªí")
'¡ô¥OSh ¬O ¾Þ§@ªí
R = Sh.UsedRange.EntireRow.Rows.Count
'¡ô¥OR ¬O¦³¨Ï¥Îªº¦C¼Æ
C = Sh.UsedRange.EntireColumn.Columns.Count
'¡ô¥OC ¬O¦³¨Ï¥ÎªºÄæ¼Æ
Set Arr = Range(Sh.[a1], Sh.Cells(R, C))
'¡ô¥OArr¬OÀx¦s®æ¶°!½d³ò¬O³Ì¤jªº¤w¨Ï¥Î®æ½d³ò
For Each xR In Arr
'¡ô³]¶¶°j°é!¥OxR ¬OArrÀx¦s®æ¶°ªº¤@­û
    If IsNumeric(xR.Value) = False Or xR.Value = "" Then GoTo 888
    '¡ô¦pªG °}¦C­È¤£¬O¼Æ¦r ©Î °}¦C­È¬OªÅ¦r¤¸! ´N¸õ¨ì 888¦ì¸mÄ~Äò°õ¦æ
    crl = xR.Interior.Color
    '¡ô¥tcrl ¬O©³¦âÃC¦â¸¹
    y = 2
    '¡ô¥Oy ¨C¦¸ªº°j°éªì©l­È³£¬O 2!³o¬OBrr°}¦C¸Ìªºµ²ªG¦C¼Æ(¥H¤UºÙ_Brrµ²ªG¦C)
    '¦]¬°³o¬O­n±q²Ä3¦C¶}©l©ñ©ú²Ó­È!©Ò¥Hªì©l­È¬O2Åý«áµ{§Ç¥[ 1=3!
    '¦¹­È­Ë¤J¦r¨å xD(crl)«á¦AÄ~Äò²Ö¥[ 1
    If xD.Exists(crl) Then
    '¡ô¦pªG¥H xR©³¦âÃC¦â¸¹¬°KEY¬d¹î xD¦r¨å¬O¦³¦¹Áä!
        y = xD(crl)
        '¡ô±ø¥ó¦¨¥ß!´N¥Oy ¬O¦r¨å¸Ì¹ïÀ³key¬° (xR©³¦âÃC¦â¸¹)ªºitem­È
        x1 = xD(crl & "_C")
        '¡ô±ø¥ó¦¨¥ß!´N¥Ox1 ¬O¦r¨å¸Ì¹ïÀ³key¬° (xR©³¦âÃC¦â¸¹& "_C")ªºitem­È
        'x1¬O¦bBrr°}¦C¸Ìªºµ²ªGÄæ¼Æ(¥H¤UºÙ_Brrµ²ªGÄæ)ªº·N«ä
        Brr(2, x1) = Brr(2, x1) + xR.Value
        '¡ô±ø¥ó¦¨¥ß!´NÅýBrr°}¦C¸Ì(²Ä2¦C/Brrµ²ªGÄæ)¹ïÀ³ªº¦ì¸m­È»P ArrÀx¦s®æ_xR­È²Ö¥[
        Brr(y + 1, x1) = xR.Value
        '¡ô±ø¥ó¦¨¥ß!´NÅýBrr°}¦C¸Ì(²ÄyÅܼÆ+1¦C/Brrµ²ªGÄæ)¹ïÀ³ªº¦ì¸mµ¥©ó ArrÀx¦s®æ_xR­È
        xD(crl) = y + 1
        '¡ô±ø¥ó¦¨¥ß!Brrµ²ªG¦C²Ö¥[ 1
    Else
    '¡ô¦pªG±ø¥ó¤£¦¨¥ß! °j°éªº¤@¶}©l±ø¥ó¤£·|¦¨¥ß! ²Ä¤@¦¸¹J¨ì¤£¦P©³¦â ±ø¥ó¤]¤£·|¦¨¥ß!
        x = x + 1
        '¡ôx¬Oµu¾ã¼Æ!ªì©l­È¬O0! ²Ö¥[ 1!³o¬O ©³¦âÃC¦â¸¹ªººØÃþ¼Æ!
        '¹J¨ì¦r¨å¸Ì¨S¦³ªº ©³¦âÃC¦â¸¹ºØÃþ®É!´N­n¥[ 1
        Brr(1, x) = crl
        '¡ôBrr°}¦C(²Ä¤@¦C/Brrµ²ªGÄæ1)­Èµ¥©ó ©³¦âÃC¦â¸¹
        Brr(2, x) = xR.Value
        '¡ôBrr°}¦C(²Ä¤G¦C/Brrµ²ªGÄæ1)­Èµ¥©ó ArrÀx¦s®æ_xR­È(²Ä¤@­Ó¼Æ¦r¥[Á`­È)
        y = y + 1
        '¡ôyªº«Å§i¬O¦r¦ê!¼Æ¦r¦r¦ê¬O¥i¥H°µ¼Æ¾Ç¹Bºâªº!¶W°ª¿³!¾Ç¨ì¤F!
        'yªº²Ä¤@­È¬O "2" + 1 «á¬O "3"
        Brr(y, x) = xR.Value
        '¡ôBrr°}¦C(²Ä¤T¦C/Brrµ²ªGÄæ1)­Èµ¥©ó ArrÀx¦s®æ_xR­È(²Ä¤@­Ó©ú²Ó­È)
        xD(crl) = y
        '¡ô§â©³¦âÃC¦â¸¹¬°key,­Ë¤J¦r¨å¤¤,item¬O 3
        xD(crl & "_C") = x
        '¡ô§â(©³¦âÃC¦â¸¹ & "_C")¦r¦ê ¬°key,­Ë¤J¦r¨å¤¤,item¬O «e¤èªº©³¦âÃC¦â¸¹ªººØÃþ¼Æ1
    End If
888: Next
Workbooks.Add
[a1] = "ÃC¦â¡÷": [A2] = "¼Æ¦r¥[Á`¡÷": [A3] = "¡õ¥H¤U¬O©ú²Ó"
[B1].Resize(1000, x) = Brr
'¡ô±q¤u§@ªí[B1]¶}©l¶K¤JBrr°}¦C¸ê®Æ
For j = 1 To x
'¡ô³]¶¶°j°é!±q1 ¨ì ©³¦âÃC¦â¸¹ªººØÃþ³Ì«á²Ö¥[¼Æ
   Cells(1, j + 1).Interior.Color = Brr(1, j)
   '¡ô§â²Ä¤@¦Cªº©³¦â¥Î¤º®e¸Ìªº©³¦â¸¹¤W¦â
Next
Range(Cells(1, 2), Cells(1, x + 1)) = ""
'¡ô§â²Ä¤@¦Cªº©³¦â¸¹²M°£
Cells.Columns.AutoFit
'¡ô¥þ³¡Äæ¦ì¦Û°Ê½Õ¾ãÄæ¼e
Cells.Borders.LineStyle = 1
'¡ô¥þ³¡Àx¦s®æ®æ½u¬°²Ó¹ê½u
MsgBox Timer - T & " ’"
End Sub
¬Ý±oÀ´¬OÀ³¸Óªº!·|¥Î¤S¬O¥t¤@¦^¨Æ!¶Ô½m´N¹ï¤F!