[µo°Ý] ¦r¦ê§R°£­«½Æ

qaqa3296

¤U¸ü (59.65 KB)

2020-10-10 20:00

·Q±NCÄæ­«½Æªº¶µ¥Ø§R°£¡AÅܦ¨DÄ檺®ÄªG

µ{¦¡¥Ø«e¥\¯à¬O³æ±ø¥ó¦hµ²ªG¦C¥X¡A¨Ã±N¦C¥X¸ê®Æ¥H"¡A"¹j¶}
Sub test1()
[®Æ¥ó!C2:C6000].ClearContents '²M°£C¸ê®Æ
Set xD = CreateObject("Scripting.Dictionary") '¦r¨å
Sheets("®Æ¥ó").Select '¸õ¨ì
arr = Range([¦ì¸m!A2], [¦ì¸m!D65536].End(xlUp))
For i = 1 To UBound(arr)
    xD(arr(i, 1)) = xD(arr(i, 1)) & "," & arr(i, 4)
Next i
Set xR = Range([A2], [A65536].End(xlUp))
For Each xT In xR
    Cells(xT.Row, "C") = xD(xT.Value)
Next
Set xD = Nothing
End Sub

¸Ó¦p¦ó­×§ïµ{¦¡©O?ÁÙ¬O¥u¯à¥´±¼­«¼g?

°a¤ªºµ

¦^´_ 1# qaqa3296

¦³ªÅ¦A¬Ý¬Ý ³o¼Ë¥i¤£¥i¥H

1. Sub test1()
   
2. Application.ScreenUpdating = False
   
3.     [®Æ¥ó!C2:C6000].ClearContents '²M°£C¸ê®Æ
   
4.     Set xD = CreateObject("Scripting.Dictionary") '¦r¨å
   
5.     Sheets("®Æ¥ó").Select '¸õ¨ì
   
6.     arr = Range([¦ì¸m!A2], [¦ì¸m!D65536].End(xlUp))
   
7.     Range(Sheets(2).Cells(2, 1).End(xlDown), Sheets(2).Cells(2, 4)).Sort Sheets(2).Cells(2, 4).End(xlDown)
   
8.    
   
9.     For I = 1 To UBound(arr)
   
10.         If I = UBound(arr) Then Exit For
    
11.         If arr(I, 4) <> arr(I + 1, 4) Then
    
12.             xD(arr(I, 1)) = xD(arr(I, 1)) & "," & arr(I, 4)
    
13.         End If
    
14.     Next I
    
15.    
    
16.     Set xR = Range([A2], [A65536].End(xlUp))
    
17.     For Each xT In xR
    
18.         Cells(xT.Row, "C") = xD(xT.Value)
    
19.     Next
    
20.    
    
21.     Set xD = Nothing
    
22. Application.ScreenUpdating = True
    
23. End Sub

½Æ»s¥N½X

­ã´£³¡ªL

Sub TEST_A1()
Dim Arr, xD, i&, T1$, T2$, T3$
Set xD = CreateObject("Scripting.Dictionary")
Arr = Range([¦ì¸m!A1], [¦ì¸m!D65536].End(xlUp))
For i = 2 To UBound(Arr)
    T1 = Arr(i, 1): T2 = Arr(i, 4)
    If T1 = "" Or T2 = "" Then GoTo 101
    T3 = T1 & "|" & T2:  xD(T3) = xD(T3) + 1 '¥Î¨â­ÓÃöÁä¦r²Õ¦X, ±Æ°£­«ÂÐ
    If xD(T3) = 1 Then xD(T1) = xD(T1) & "," & T2  'xD(T3) = 1 ¬°­º¦¸¥X²{ªº, ¥[¤J¦r¦ê¤¤, ¶W¹L1, ²¤¹L
101: Next i
Arr = Range([®Æ¥ó!A1], [®Æ¥ó!A65536].End(xlUp))
For i = 2 To UBound(Arr)
    Arr(i - 1, 1) = Mid(xD(Arr(i, 1) & ""), 2) '¦r¦ê­º¦r²Å¬°"³r¸¹", ¶·¥Îmid¨ú²Ä2­Ó¦r¥H«áªº¦r¤¸
Next i
[®Æ¥ó!C2].Resize(UBound(Arr) - 1) = Arr
End Sub

­ã´£³¡ªL

Sub TEST_A2()
Dim Arr, xD, i&, T1$, T2$, T3$, xR As Range
Set xD = CreateObject("Scripting.Dictionary")
Arr = Range([¦ì¸m!A1], [¦ì¸m!D65536].End(xlUp))
For i = 2 To UBound(Arr)
    T1 = Arr(i, 1): T2 = Arr(i, 4)
    If T1 = "" Or T2 = "" Then GoTo 101
    T3 = T1 & "|" & T2:  xD(T3) = xD(T3) + 1
    If xD(T3) = 1 Then xD(T1) = xD(T1) & IIf(xD(T1) = "", "", ",") & T2  '¥Î iif ÁקK¦r¦ê¶}ÀY¥X²{"³r¸¹"
101: Next i
For Each xR In Range([®Æ¥ó!A2], [®Æ¥ó!A65536].End(xlUp)) 'ª½±µ¦bÀx¦s®æ³v¤@¶ñ¤J, ³t«×ºC
    xR(1, 3) = xD(xR & "")  'ª`·N:xD(xR & "") ¤¤ªº"Âù¤Þ¸¹"¤£¥i¬Ù²¤, ©Î¥ÎxD(xR.Value)
Next
End Sub

­ã´£³¡ªL

¦r¨åªºkeyªº«¬ºA¶·©ú½T¬É©w,
"¼Æ­È"¤Î"¤å¦r"®æ¦¡, ·|µø¬°¤£¦P,
¨Ò¦p: xd(123) ¤Î xd("123") µø¬°¤£¦P,
©Ò¥H³Ì¦n¥ÎÅܼƥN´À, ¦A°µ¦r¨åkey,
dim T$ ©Î  dim T as string
T = 123
xd(T) §Yµ¥¦P xd("123")

­^¤å¤j¤p¼g¤]µø¬°¤£¦P,
¨Ò¦p: xd("ABC") ¤Î xd("Abc") µø¬°¤£¦P,
¥²­n®É¥i¥Îucase ©Î lcase ²Î¤@¤j¤p¼g, ¦A¸m¤J¦r¨å

hcm19522

https://blog.xuite.net/hcm195222/blog/589401247

°a¤ªºµ

ÁÂÁ ­ã´£¤j¤j ©M hcm19522 ¤j¤j ªº «ü¾É
¥Î .Sort ·|¥X²{ ©_©Çªº°ÝÃD ­nÂI2¦¸°õ¦æ¤~·|¥¿±` ¤£ª¾¹D¬°¬Æ»ò

qaqa3296

·PÁ°a¤ªºµ¡B­ã´£³¡ªL©Mhcm19522ªº¦^´_

¦³µo²{°a¤ªºµµ{¦¡ÂI¨â¦¸¤~¥¿±`ªº°ÝÃD¡A¦ý¤]¬Ý¤£¥X¬°¤°»ò

hcm19522´£¨Ñªº¨ç¼ÆÆZ¦³·N«ä¡A§Ú¤@¶}©l¤]¬O¥Î¨ç¼Æ¼g¡Aµ²ªG¸ê®Æ¶]¤F30¤ÀÄÁ¡A¤Ó¤[¤F¤~¶}©l¥ÎVBA½m²ß

·PÁ­㴣³¡ªL±Ðªº¼gµ{¦¡¤p§Þ¥©¥H¤Îª`·N¨Æ¶µ

¦³¾Ç¨ìªF¦è¡A¨ü¯q¨}¦h

Andy2483

¦^´_ 3# ­ã´£³¡ªL


    ÁÂÁ«e½ú
«á¾ÇÂǦ¹©«¾Ç²ß«e½úªº¤è®×µy§@ÅܤÆ,¤è®×¾Ç²ß¤ß±o¦Ü¸Ñ¦p¤U,½Ð«e½ú¦A«ü¾É

¸ê®Æªí:

¤U¸ü (120.15 KB)

2023-5-16 16:12

µ²ªGªí°õ¦æ«e:

¤U¸ü (51.95 KB)

2023-5-16 16:13

°õ¦æµ²ªG:

¤U¸ü (61.35 KB)

2023-5-16 16:13

Option Explicit
Sub TEST()
Dim Arr, xD, i&, T1$, T2$, T3$
'¡ô«Å§iÅܼÆ
Set xD = CreateObject("Scripting.Dictionary")
'¡ôxDÅܼƬO ¦r¨å
Arr = Range([¦ì¸m!A1], [¦ì¸m!D65536].End(xlUp))
'¡ô¥OArrÅܼƬO ¤Gºû°}¦C,¥HÀx¦s®æ­È±a¤J°}¦C¤¤
For i = 2 To UBound(Arr)
'¡ô³]¶¶°j°é
    T1 = Arr(i, 1): T2 = Arr(i, 4)
    '¡ô¥O°j°éArr°}¦C­È¥HÅܼƩӸË,¶¶¹D©w¸q¨ä­È¬O¦r¦ê
    If T1 = "" Or T2 = "" Then GoTo i01
    '¡ô¦pªG«~¸¹©Î «~¦W¬OªÅªº,¤£°õ¦æ!¸õ¨ì i01¼Ð¥Ü¦ì¸mÄ~Äò°õ¦æ
    T3 = T1 & "|" & T2:  xD(T3) = xD(T3) + 1
    '¡ô¥OT3¬O¥H"|"¶¡¹jªº²Õ¦X¦r¦ê,
    '¥OT3ÅܼƷíkey,item¬O¦Û¨­²Ö¥[ 1,¯Ç¤JxD¦r¨å
    If xD(T3) = 1 Then xD(T1) = Trim(xD(T1) & " " & T2)
    '¡ô¦pªGT3ÅܼƬO²Ä1¦¸¯Ç¤J¦r¨å(item­È=1),
    '´N¥OT1ÅܼƷíkey,item¬O¦Û¨­­È³s±µT2ÅܼÆ,¤¤¶¡¥HªÅ¥Õ¦r¤¸¹j¶},
    '³Ì«á¦A¥h°£ÀY§ÀªºªÅ¥Õ¦r¤¸
i01: Next i
Arr = Range([®Æ¥ó!A1], [®Æ¥ó!A65536].End(xlUp))
'¡ô¥OArrÅܼƬO ¤Gºû°}¦C,¥HÀx¦s®æ­È±a¤J°}¦C¤¤
For i = 2 To UBound(Arr)
'¡ô³]¶¶°j°é
    Arr(i - 1, 1) = Replace(xD(Arr(i, 1) & ""), " ", ",")
    '¡ô¥O¥H°j°éArr°}¦C­È¬dxD¦r¨å±o¨ìitem­È,¸g¸m´«ªÅ¥Õ¦r¤¸¬°³r¸¹,
    'Âл\±¼­ìArr°}¦C­È
Next i
[®Æ¥ó!C2].Resize(UBound(Arr) - 1) = Arr
'¡ô¥O[®Æ¥ó!C2]ÂX®i¦V¤UArr°}¦C³Ì¤j¯Á¤Þ¸¹-1­ÓÀx¦s®æ½d³ò­È,
'¥HArr°}¦C±a¤J,¶W¹L¦¹½d³òªº°}¦C­È³Q©¿²¤
End Sub