¦P¤@µo²¼¸¹½X¦C¥X©Ò¦³q³æ½s¸¹(¦C¦b¦P¤@Àx¦s®æ)
- ©«¤l
- 334
- ¥DÃD
- 139
- ºëµØ
- 0
- ¿n¤À
- 621
- ÂI¦W
- 0
- §@·~¨t²Î
- WINDOWSXP
- ³nÅ骩¥»
- OFFICE2003
- ¾\ŪÅv
- 50
- ©Ê§O
- ¤k
- ¨Ó¦Û
- ¥x¥_¿¤
- µù¥U®É¶¡
- 2010-8-5
- ³Ì«áµn¿ý
- 2022-11-3
|
¦P¤@µo²¼¸¹½X¦C¥X©Ò¦³q³æ½s¸¹(¦C¦b¦P¤@Àx¦s®æ)
¦C¥X¦P¤@µo²¼¸¹½Xªº©Ò¦³q³æ½s¸¹(Åã¥Ü¦b¦P¤@Àx¦s®æ)
µª®×§e²{µ²ªG¦pDÄæ¤ÎEÄæ |
|
joyce
|
|
|
|
|
- ©«¤l
- 1447
- ¥DÃD
- 40
- ºëµØ
- 0
- ¿n¤À
- 1471
- ÂI¦W
- 0
- §@·~¨t²Î
- Windows 7
- ³nÅ骩¥»
- Excel 2010 & 2016
- ¾\ŪÅv
- 50
- ©Ê§O
- ¨k
- ¨Ó¦Û
- ¥xÆW
- µù¥U®É¶¡
- 2020-7-15
- ³Ì«áµn¿ý
- 2024-12-5
|
¦^´_ 11# ã´£³¡ªL
ÁÂÁ«e½ú
¤@¦~¦h¤F,²{¦b¤~¤j·§¬ÝÀ´
°õ¦æµ²ªG:
Option Explicit
Sub test_02()
Dim i&, N&, R&, T$, T2$, C%, Cx%, Arr, Brr, xD
'¡ô«Å§iÅܼÆ(i,N,R)¬Oªø¾ã¼ÆÅܼÆ,(T,T2)¬O¦r¦êÅܼÆ,(C,Cx)¬Oµu¾ã¼ÆÅܼÆ,
'¨ä¥¦¬O³q¥Î«¬ÅܼÆ
Set xD = CreateObject("Scripting.Dictionary")
'¡ô¥OxD¬O ¦r¨å
Arr = Range([a1], [b65536].End(3))
'¡ô¥OArr¬O¤Gºû°}¦C!¥H[A1]¨ìBÄæ³Ì«á¤@Ó¦³¤º®eÀx¦s®æ,³o½d³òÀx¦s®æȱa¤J
ReDim Brr(1 To UBound(Arr), 1 To 200)
'¡ô«Å§iBrr°}¦C½d³ò!Áa¦V±q1¨ìArr°}¦C³Ì¤j¯Á¤Þ¦C¸¹,¾î¦V±q1¨ì200
For i = 2 To UBound(Arr)
'¡ô³]¶¶°j°é!i±q2¨ì Arr°}¦C³Ì¤j¯Á¤Þ¦C¸¹
T = Arr(i, 1)
'¡ô¥OT³o¦r¦êÅܼƬO i°j°é¦C1ÄæArr°}¦CÈ
T2 = Arr(i, 2)
'¡ô¥OT2³o¦r¦êÅܼƬO i°j°é¦C2ÄæArr°}¦CÈ
If T = "" Or T2 = "" Then GoTo 99
'¡ô¦pªGT¦r¦êÅܼƬO ªÅ¦r¤¸ ©Î ¦pªGT2¦r¦êÅܼƬO ªÅ¦r¤¸,´N¸õ¨ì99¦ì¸mÄ~Äò°õ¦æ
R = xD(T)
'¡ô¥OR³oªø¾ã¼ÆÅܼƬO ¥HT¦r¦êÅܼƬdxD¦r¨å¦^¶ÇªºitemÈ (PS:Y¬d¤£¨ì!Rªì©lȬO 0)
C = xD(T & "/c")
'¡ô¥OC³oµu¾ã¼ÆÅܼƬO ¥HT¦r¦êÅܼƳs±µ"/c"ªº·s¦r¦ê,¬dxD¦r¨å¦^¶ÇªºitemÈ
'(PS:Y¬d¤£¨ì!Cªì©lȬO 0)
If R = 0 Then
'¡ô¦pªGRÅܼƬO 0 ??
N = N + 1
'¡ô¥ON³oªø¾ã¼ÆÅܼƬO ¦Û¨È +1 (PS:Nªì©lȬO 0)
R = N + 1
'¡ô¥ORÅܼƬO NÅÜ¼Æ +1
xD(T) = R
'¡ô¥O¥HTÅܼƷíkey,item¬O RÅܼÆ,©ñ¦^¦r¨å
Brr(R, 1) = Arr(i, 1)
'¡ô¥OÅܼƦC1ÄæBrr°}¦CȬO i°j°é¦C1ÄæArr°}¦CÈ
End If
C = C + 1
'¡ô¥OCÅܼƬO ¦Û¨È +1
xD(T & "/c") = C
'¡ô¥O¥HTÅܼƳs±µ"/c"ªº·s¦r¦ê·íkey,item¬O CÅܼÆ,©ñ¤J¦r¨å
Brr(R, C + 1) = T2
'¡ô¥ORÅܼƦC(C1ÅܼÆ+1)ÄæBrr°}¦CȬO T2¦r¦êÅܼÆ
If C > Cx Then Cx = C: Brr(1, Cx + 1) = "q³æ(" & Cx & ")"
'¡ô¦pªGCÅÜ¼Æ > Cx³oµu¾ã¼ÆÅܼÆ,´N¥OCxÅܼƬO CÅܼÆ,
'1¦C(CxÅܼÆ+1)ÄæBrr°}¦CȬO "q³æ(" ³s±µ CxÅÜ¼Æ ¦A³s±µ ")" ²Õ¦¨ªº·s¦r¦ê
99: Next i
Brr(1, 1) = "µo²¼¸¹½X"
Range("g1").Resize(N + 1, Cx + 1) = Brr
'[G1]Àx¦s®æÂX®i¦V¤U(NÅܼÆ+1)¦C,¦V¥kÂX®i(CxÅܼÆ+1)Äæ,³o½d³òÀx¦s®æÈ¥HBrr°}¦Cȱa¤J
End Sub |
|
¥Î¦æ°Ê¸Ë¸mÂsÄý½×¾Â¾Ç²ß«Ü¤è«K,ÁÂÁ½׾¸gÀç¹Î¶¤
½Ð¤j®a¤@°_¤W½×¾Â¨Ó¥æ¬y
|
|
|
|
|
- ©«¤l
- 2839
- ¥DÃD
- 10
- ºëµØ
- 0
- ¿n¤À
- 2895
- ÂI¦W
- 0
- §@·~¨t²Î
- ¡e²¤¡f
- ³nÅ骩¥»
- ¡e²¤¡f
- ¾\ŪÅv
- 100
- ©Ê§O
- ¨k
- ¨Ó¦Û
- ¡e²¤¡f
- µù¥U®É¶¡
- 2013-5-13
- ³Ì«áµn¿ý
- 2024-12-25
|
¦hÄ榡:
Sub test_02()
Dim Arr, Brr, xD, i&, T$, T2$, R&, C%, Cx%, N&
Set xD = CreateObject("Scripting.Dictionary")
Arr = Range([a1], [b65536].End(3))
ReDim Brr(1 To UBound(Arr), 1 To 200)
For i = 2 To UBound(Arr)
T = Arr(i, 1): T2 = Arr(i, 2)
If T = "" Or T2 = "" Then GoTo 99
R = xD(T): C = xD(T & "/c")
If R = 0 Then N = N + 1: R = N + 1: xD(T) = R: Brr(R, 1) = Arr(i, 1)
C = C + 1: xD(T & "/c") = C: Brr(R, C + 1) = T2
If C > Cx Then Cx = C: Brr(1, Cx + 1) = "q³æ(" & Cx & ")"
99: Next i
Brr(1, 1) = "µo²¼¸¹½X"
Range("g1").Resize(N + 1, Cx + 1) = Brr
End Sub |
|
|
|
|
|
|
- ©«¤l
- 2839
- ¥DÃD
- 10
- ºëµØ
- 0
- ¿n¤À
- 2895
- ÂI¦W
- 0
- §@·~¨t²Î
- ¡e²¤¡f
- ³nÅ骩¥»
- ¡e²¤¡f
- ¾\ŪÅv
- 100
- ©Ê§O
- ¨k
- ¨Ó¦Û
- ¡e²¤¡f
- µù¥U®É¶¡
- 2013-5-13
- ³Ì«áµn¿ý
- 2024-12-25
|
¨âÄ榡:
Sub test_01()
Dim Arr, xD, i&, T$, T2$, R&, N&
Set xD = CreateObject("Scripting.Dictionary")
Arr = Range([a1], [b65536].End(3))
For i = 2 To UBound(Arr)
T = Arr(i, 1): T2 = Arr(i, 2): R = xD(T)
If T = "" Or T2 = "" Then GoTo 99
If R > 0 Then Arr(R, 2) = Arr(R, 2) & "¡B" & T2: GoTo 99
N = N + 1: R = N + 1: xD(T) = R
Arr(R, 1) = Arr(i, 1): Arr(R, 2) = T2
99: Next i
Range("d1").Resize(N + 1, 2) = Arr
End Sub |
|
|
|
|
|
|
- ©«¤l
- 1447
- ¥DÃD
- 40
- ºëµØ
- 0
- ¿n¤À
- 1471
- ÂI¦W
- 0
- §@·~¨t²Î
- Windows 7
- ³nÅ骩¥»
- Excel 2010 & 2016
- ¾\ŪÅv
- 50
- ©Ê§O
- ¨k
- ¨Ó¦Û
- ¥xÆW
- µù¥U®É¶¡
- 2020-7-15
- ³Ì«áµn¿ý
- 2024-12-5
|
¦^´_ 8# samwang
ÁÂÁ«ü¾É!
¦pªG¦C¼Æ¦h!±zªº°õ¦æªº®É¶¡¤ñ§Ú·|ªº¤è¦¡§Ö«Ü¦h!
ÁÂÁ«e½ú«ü¾É! xD(k)(C - 2)
Sub test2_1()
Dim Arr, Brr(), xD, T$, k, MA%, R%, C%
Set xD = CreateObject("Scripting.Dictionary")
Arr = Range([a1], [b65536].End(3))
For i = 2 To UBound(Arr)
T = Arr(i, 1): If T = "" Then GoTo 99
xD(T) = xD(T) + 1
99: Next i
MA = WorksheetFunction.Max(xD.Items)
ReDim Brr(0 To xD.Count, 1 To MA + 1)
i = 0
For Each k In xD.keys
Brr(i, 1) = k
R = 2
For C = 2 To UBound(Arr)
If Arr(C, 1) = Brr(i, 1) Then
Brr(i, R) = Arr(C, 2)
R = R + 1
End If
Next
i = i + 1
Next
Range("g2").Resize(xD.Count, MA + 1) = Brr
End Sub |
|
|
|
|
|
|
- ©«¤l
- 976
- ¥DÃD
- 7
- ºëµØ
- 0
- ¿n¤À
- 1018
- ÂI¦W
- 0
- §@·~¨t²Î
- Win10
- ³nÅ骩¥»
- Office 2016
- ¾\ŪÅv
- 50
- ©Ê§O
- ¨k
- µù¥U®É¶¡
- 2013-4-19
- ³Ì«áµn¿ý
- 2024-12-18
|
¦^´_ samwang
ÁÂÁ«ü¾É
¦A½Ð±Ð
¦pªGµo²¼¸¹½X¹ïÀ³ªº«È¤áq³æ¤£n¥Î¡B²Å¸¹Ó¶}©ñ¦P¤@Àx¦s®æ,
...
Andy2483 µoªí©ó 2021-10-14 12:35
Sub test2()
Dim Arr, Brr(), xD, T$, k, TC%, TC1%, R%, C%
Set xD = CreateObject("Scripting.Dictionary")
Arr = Range([a1], [b65536].End(3))
For i = 2 To UBound(Arr)
T = Arr(i, 1): If T = "" Then GoTo 99
If xD.Exists(T) Then
xD(T) = xD(T) & "¡B" & Arr(i, 2)
Else
xD(T) = Arr(i, 2)
End If
99: Next i
ReDim Brr(1 To xD.Count, 1 To UBound(Arr))
R = 1
For Each k In xD.keys
xD(k) = Split(xD(k), "¡B")
TC = UBound(xD(k)) + 2
If TC > TC1 Then TC1 = TC
Brr(R, 1) = k
For C = 2 To UBound(xD(k)) + 2
Brr(R, C) = xD(k)(C - 2)
Next
R = R + 1
Next
Range("g2").Resize(R - 1, TC1) = Brr
End Sub |
|
|
|
|
|
|
- ©«¤l
- 1447
- ¥DÃD
- 40
- ºëµØ
- 0
- ¿n¤À
- 1471
- ÂI¦W
- 0
- §@·~¨t²Î
- Windows 7
- ³nÅ骩¥»
- Excel 2010 & 2016
- ¾\ŪÅv
- 50
- ©Ê§O
- ¨k
- ¨Ó¦Û
- ¥xÆW
- µù¥U®É¶¡
- 2020-7-15
- ³Ì«áµn¿ý
- 2024-12-5
|
¦^´_ 6# samwang
ÁÂÁ«ü¾É
¦A½Ð±Ð
¦pªGµo²¼¸¹½X¹ïÀ³ªº«È¤áq³æ¤£n¥Î¡B²Å¸¹Ó¶}©ñ¦P¤@Àx¦s®æ,
¦Ó¬O¤À¶}©ñ¦b¥k°¼ªºÀx¦s®æ±µ¤U¥h©ñ!n«ç»ò§ï? |
|
|
|
|
|
|
- ©«¤l
- 976
- ¥DÃD
- 7
- ºëµØ
- 0
- ¿n¤À
- 1018
- ÂI¦W
- 0
- §@·~¨t²Î
- Win10
- ³nÅ骩¥»
- Office 2016
- ¾\ŪÅv
- 50
- ©Ê§O
- ¨k
- µù¥U®É¶¡
- 2013-4-19
- ³Ì«áµn¿ý
- 2024-12-18
|
¦^´_ samwang
½Ð±Ð«e½ú ¦r¨å¥u¯à1Ókey¹ïÀ³item? ¥i¥H1Ó¹ï¦hÓ¶Ü?
Andy2483 µoªí©ó 2021-10-14 12:00
key¥i¥H«Ü¦hÓ¡A¦ý¬O¨CÓkey ¬O°ß¤@¡A¥B¹ïÀ³ªºitem¥i¥H«Ü¦hÓ¡AÁÂÁ¡C |
|
|
|
|
|
|
- ©«¤l
- 1447
- ¥DÃD
- 40
- ºëµØ
- 0
- ¿n¤À
- 1471
- ÂI¦W
- 0
- §@·~¨t²Î
- Windows 7
- ³nÅ骩¥»
- Excel 2010 & 2016
- ¾\ŪÅv
- 50
- ©Ê§O
- ¨k
- ¨Ó¦Û
- ¥xÆW
- µù¥U®É¶¡
- 2020-7-15
- ³Ì«áµn¿ý
- 2024-12-5
|
¦^´_ 4# samwang
½Ð±Ð«e½ú ¦r¨å¥u¯à1Ókey¹ïÀ³item? ¥i¥H1Ó¹ï¦hÓ¶Ü? |
|
|
|
|
|
|
- ©«¤l
- 976
- ¥DÃD
- 7
- ºëµØ
- 0
- ¿n¤À
- 1018
- ÂI¦W
- 0
- §@·~¨t²Î
- Win10
- ³nÅ骩¥»
- Office 2016
- ¾\ŪÅv
- 50
- ©Ê§O
- ¨k
- µù¥U®É¶¡
- 2013-4-19
- ³Ì«áµn¿ý
- 2024-12-18
|
¦^´_ 1# leiru
½Ð´ú¸Õ¬Ý¬Ý¡AÁÂÁÂ
Sub test()
Dim Arr, xD, i&, T$
Set xD = CreateObject("Scripting.Dictionary")
Arr = Range([a1], [b65536].End(3))
For i = 2 To UBound(Arr)
T = Arr(i, 1): If T = "" Then GoTo 99
If xD.Exists(T) Then
xD(T) = xD(T) & "¡B" & Arr(i, 2)
Else
xD(T) = Arr(i, 2)
End If
99: Next i
Range("d2").Resize(xD.Count, 1) = Application.Transpose(xD.keys)
Range("e2").Resize(xD.Count, 1) = Application.Transpose(xD.Items)
End Sub |
|
|
|
|
|
|