[µo°Ý] (¦r¨åª«¥ó)³æ®æ¦h¦æÀx¦s®æ¤À¹j¬°¦h¦æ³æ®æÀx¦s®æ°ÝÃD

greetingsfromtw

¦U¦ì«e½ú¦n,

¤p§Ì³Ìªñ¦b½m²ß®É¹J¨ì¤@­Ó°ÝÃD,
ªþ¤WÀÉ®×¥H¨Ñ«e½ú°Ñ¦Ò:

20161115_(¦r¨åª«¥ó)³æ®æ¦h¦æÀx¦s®æ¤À¹j¬°¦h¦æ³æ®æÀx¦s®æ°ÝÃD.zip (9.86 KB)

¤U¸ü¦¸¼Æ: 16

2016-11-15 21:39

±N°ÝÃD¥H¤å¦r²­z¦p¤U:

°²³]¦³¨âª½Äæ¸ê®Æ,
AÄ欰¤@¯ë¤å¦r,BÄ檺¨C­ÓÀx¦s®æ§¡¦³¦hµ§¸ê®Æ,¨Cµ§¸ê®Æ¦³´«¦æ,

¥Ü·N¦p¤U:
BÄæ
111
222
333
¥H¤W¤Tµ§¼Æ¦r§¡¦b¦P¤@­ÓÀx¦s®æ¤¤.

§Æ±æ¥i¥H±NBÄ檺¨Cµ§¸ê®Æ¤À¹j¦Ü³æ¤@Àx¦s®æ,¶K¦ÜFÄæ,
¨Ã±NAÄ檺¸ê®Æ¨Ì¾ÚBÄ檺¸ê®Æ¥h¶K¤W,
©Ó¤W¨Ò,
°²³]¤W¨Ò¤§BÄæ¹ïÀ³¤§AÄæÀx¦s®æ¬°"AAA",
«h´Á±æµ²ªG¦p¤U:
AÄæ    BÄæ
AAA   111
AAA   222
AAA   333

¤p§Ì«_¬N­É¥Î½×¾Â«e½ú¥H¤Îºô¤W¨ä¥LªB¤Íªºµ{¦¡½X¶i¦æ­×§ï,
­×§ï¤§µ{¦¡½X¦p¤U:

1. Sub test()
   
2. '¦¹¬°°Ñ¦Ò½×¾Â«e½ú¤Îºô¤W¨ä¥LªB¤Í©Ò´£¨Ñ¤§µ{¦¡½X¶i¦æ­×§ï,
   
3. '«D§Ú­ì³Ð
   
4. '½×¾Âºô§};http://forum.twbts.com/thread-18600-1-1.html
   
5. Dim Arr, Brr(1 To 65536, 1 To 1), myD, C, UC
   
6. 'Ãö³¬¿Ã¹õ§ó·s
   
7. Application.ScreenUpdating = False
   
8. 
   
9. Set myD = CreateObject("scripting.dictionary")
   
10. Arr = Range("a2:c" & Cells(Rows.Count, "a").End(3).Row).Value
    
11. 
    
12. '²M°£µ²ªGÄ檺¸ê®Æ
    
13. Range("e2", Cells(Rows.Count, "f")).ClearContents
    
14. 
    
15. For Each A In Range("b2:b" & Cells(Rows.Count, "b").End(3).Row).Value
    
16.     For Each B In Split(A, Chr(10))
    
17.    
    
18.     '±NBÄæ¦h¦æÀx¦s®æ¤ºªº­È¤À³Î¨Ã¥N¤J°}¦C,
    
19.     '¨Ï¥Î¦r¨åª«¥ó±N­«½Æ­È§R°£
    
20.     If myD(B) = 1 Then GoTo 101
    
21.         N = N + 1
    
22.         Brr(N, 1) = B
    
23.         myD(B) = 1
    
24. 101:    Next B
    
25. Next A
    
26. [f2].Resize(N, 1) = Brr
    
27. 
    
28. 
    
29. '"---"µê½u½d³ò¤ºªºµ{¦¡½X¦bBÄæ¦h¦æÀx¦s®æ¦³­«½Æ¸ê®Æ©ÎªÅ¦æ®É·|¥X²{°ÝÃD
    
30. '-------------------------------------------------------
    
31. 
    
32. '­pºâBÄæ¦h¦æÀx¦s®æ¤ºªº­ÈªºÁ`¼Æ¶q¨ÃÅã¥Ü©óCÄæ
    
33. For i = 1 To UBound(Arr)
    
34.     C = Split(Arr(i, 2), Chr(10))
    
35.     UC = UBound(C) + 1
    
36.     Arr(i, 3) = UC
    
37. Next i
    
38. [a2].Resize(UBound(Arr), 3) = Arr
    
39. 
    
40. 
    
41. 
    
42. '±NAÄ檺¸ê®Æ¨ÌCÄ檺¦¸¼Æ¶K¦ÜEÄæ
    
43. For j = 2 To UBound(Arr) + 1
    
44.     Cells(j, 1).Copy _
    
45.     Cells(Rows.Count, 5).End(xlUp).Offset(1, 0).Resize(Cells(j, 3), 1)
    
46. Next j
    
47. 
    
48. '-------------------------------------------------------
    
49. 
    
50. 'CÄ檺¼Æ¦r¨Ï¥ÎªÌ¥Î¤£¨ì,¬G¦b³Ì«á²M°£CÄæ
    
51. Columns(3).ClearContents
    
52. 
    
53. '¶}±Ò¿Ã¹õ§ó·s
    
54. Application.ScreenUpdating = True
    
55. 
    
56. End Sub

½Æ»s¥N½X

¥H¤Wµ{¦¡½X­Y¹J¨ìBÄæ¸ê®Æ¦³ªÅ¦æ©Î¬O¦³­«½Æ¤§±¡§Î®É«h·|¥X²{°ÝÃD,
°ÝÃD±¡§Î·Ð½Ð°Ñ¦ÒªþÀÉ©Ò¥Ü.

¤p§Ì­W«ä³\¤[,ÁÙ¬OµLªk¸Ñ¨M,¤æÁx¤W¨Ó¨D§U,
ÁÙ±æ«e½ú¤£§[«üÂI°g¬z,¤Q¤À·PÁÂ

¸­°ê¬w

¸Õ¸Õ

1. Sub test()
   
2. Dim Arr, Brr(1 To 65536, 1 To 2), C, UC
   
3. Application.ScreenUpdating = False
   
4. Arr = Range("a2:b" & Cells(Rows.Count, "a").End(3).Row).Value
   
5. Range("e2", Cells(Rows.Count, "f")).ClearContents
   
6. For Each A In Range("b2:b" & Cells(Rows.Count, "b").End(3).Row).Value
   
7.     For Each b In Split(A, Chr(10))
   
8.         If Len(b) > 0 Then
   
9.         n = n + 1
   
10.         UC = UC + 1
    
11.         Brr(n, 1) = b
    
12.         End If
    
13.     Next b
    
14.         m = m + 1
    
15.         Brr(m, 2) = UC
    
16.         UC = 0
    
17. Next A
    
18. [f2].Resize(n, 1) = Brr
    
19. For j = 2 To UBound(Arr) + 1
    
20.     Cells(j, 1).Copy _
    
21.     Cells(Rows.Count, 5).End(xlUp).Offset(1, 0).Resize(Brr(j - 1, 2), 1)
    
22. Next j
    
23. Application.ScreenUpdating = True
    
24. End Sub

½Æ»s¥N½X

greetingsfromtw

¦^´_ 2# ¸­°ê¬w

¤Q¤À·PÁ¸­°ê¬w«e½ú´£¨Ñ¸Ñµª,¤p§Ì¦A¬ã¨s¤@¤U.

Kubi

¦^´_ 1# greetingsfromtw
½Ð´ú¸Õ
Sub newtest()
    Dim Arr, Brr(), myD As Object
    Set myD = CreateObject("Scripting.Dictionary")
    Arr = Range("a2:c" & Cells(Rows.Count, "a").End(3).Row).Value
    For i = 1 To UBound(Arr)
        For j = 0 To UBound(Split(Arr(i, 2), Chr(10)))
            If Split(Arr(i, 2), Chr(10))(j) <> "" Then myD(Split(Arr(i, 2), Chr(10))(j)) = ""
        Next j
        For Each C In myD
            n = n + 1
            ReDim Preserve Brr(1 To 2, 1 To n)
            Brr(1, n) = Arr(i, 1)
            Brr(2, n) = C
        Next C
        myD.RemoveAll
    Next i
    [E2:F65536].ClearContents
    [E2].Resize(n, 2) = Application.Transpose(Brr)
End Sub

greetingsfromtw

¦^´_ 4# Kubi

¤Q¤À·PÁÂKubi«e½úµL¨p´£¨Ñ¸Ñµª,
¸ò¸­°ê¬w«e½ú©Ò´£¨Ñ¤§µ{¦¡½X§¡¥i¦³®Ä¸Ñ¨M°ÝÃD,¦A¦¸·PÁÂ.

¥i¥Hªº¸Ü,
¬O§_¤¹³\¤p§Ì¶i¤@¨B¸ß°Ý¬ÛÃö²Ó¸`,

°²³]­nÅýBÄæ¤À³Î«áªº¸ê®Æ§¡¤£­«ÂÐ,¤£ª¾¬O§_¥i¦æ?

Á|¨Ò¦Ó¨¥,
°²³]²{¦bBª½Äæ¥u¦³¨âµ§¸ê®Æ,B2»PB3,
¨ä¤¤B2Àx¦s®æ¸ê®Æ¬°:
111
222
333,

B3Àx¦s®æ¸ê®Æ¬°:
111
555
777,

¦]111¦³­«½Æ,¬O§_¦³¿ìªk±N111¦¹µ§¸ê®Æ¥uÅã¥Ü¤@¦¸?
¤p§Ì¤æÁx,ÁٽЫe½ú¤£§[«üÂI°g¬z,¤Q¤À·PÁÂ.

hcm19522

http://blog.xuite.net/hcm19522/twblog/468529807

greetingsfromtw

¦^´_ 6# hcm19522

¤Q¤À·PÁÂhcm19522«e½ú¥H¤½¦¡´£¨Ñ¸Ñµª,¤p§Ì¦A¬ã¨s¤@¤U.
«e½úªººô¯¸¤p§Ì¦³¥[¤J³Ì·R,¥DÃD¯à±o¨ì«e½úÃöª`,¬Æ·Pºa©¯.

¸­°ê¬w

ª`ÄÀªº³¡¤À¸Ñ°£¥i¹ê²{¥h­«

1. Sub test11()
   
2. Dim Arr, Brr(1 To 100, 1 To 2), n%, rg As Range, d
   
3. Set d = CreateObject("scripting.dictionary")
   
4. Application.ScreenUpdating = False
   
5. Arr = Range("a2:b" & Cells(Rows.Count, "a").End(3).Row).Value
   
6. Range("e2", Cells(Rows.Count, "f")).ClearContents
   
7. Set rg = Range("b2:b" & Cells(Rows.Count, "b").End(3).Row)
   
8. For Each a In rg
   
9.     For Each b In Split(a, Chr(10))
   
10. '        If Not d.exists(b) Then
    
11. '            d(b) = ""
    
12.             If Len(b) > 0 Then
    
13.             n = n + 1
    
14.             Brr(n, 1) = a.Offset(0, -1)
    
15.             Brr(n, 2) = b
    
16.             End If
    
17. '        End If
    
18.     Next b
    
19. Next a
    
20. Range("f2").Resize(UBound(Brr), UBound(Brr, 2)) = Brr
    
21. Application.ScreenUpdating = True
    
22. End Sub

½Æ»s¥N½X

greetingsfromtw

¦^´_ 8# ¸­°ê¬w

¤Q¤À·PÁ¸­°ê¬w«e½ú¶O¤ß«üÂI,
µ{¦¡½X¥i½T¹ê¸Ñ¨M°ÝÃD,¤p§ÌÀò¯q¨}¦h,¦A¦¸·PÁÂ.

Andy2483

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

°õ¦æ«e:

¤U¸ü (44.4 KB)

2023-5-15 15:14

°õ¦æµ²ªG:

¤U¸ü (42.91 KB)

2023-5-15 15:14

Option Explicit
Sub TEST() '¡ô
Dim Brr, Crr, V, Y, R&, i&
'¡ô «Å§iÅܼÆ
Set Y = CreateObject("Scripting.Dictionary")
'¡ô¥OYÅܼƬO¦r¨å
Brr = Range([B2], Cells(Rows.Count, 1).End(xlUp))
'¡ô¥OBrrÅܼƬO ¤Gºû°}¦C,¥HÀx¦s®æ­È±a¤J°}¦C¤¤
ReDim Crr(1 To 1000, 1 To 2)
'¡ô«Å§i CrrÅܼƬO¤GºûªÅ°}¦C,Áa¦V¯Á¤Þ¸¹1~1000,¾î¦V¯Á¤Þ¸¹1~2
For i = 1 To UBound(Brr)
'¡ô³]¶¶°j°é!i±q1¨ìBrrÁa¦V³Ì¤j¯Á¤Þ¦C¸¹
   For Each V In Split(Brr(i, 2) & vbLf, vbLf)
   '¡ô³]³v¶µ°j°é!¥OVÅܼƬO¥H´«¦æ¦r¤¸¤À³ÎBrr°}¦C²Ä2Äæ¦r¦êªº¤@ºû°}¦C­È¤§¤@
      If Trim(V) = "" Then GoTo v01
      '¡ô¦pªGVÅܼƥh°£ÀY§ÀªÅ¦r¤¸«á¬O ªÅ¦r¤¸!´N¸õ¨ìv01¼Ð¥Ü¦ì¸mÄ~Äò°õ¦æ
      If Y(Brr(i, 1) & "|" & V) <> "" Then GoTo v01
      '¡ô¦pªGBrr°}¦C²Ä1Äæ¦r¦ê³s±µ"|",¦A³s±µVÅܼƩҲզ¨ªº¦r¦ê¬dY¦r¨åitem­È,
      'item­È¤£¬OªÅ¦r¤¸!´N¸õ¨ìv01¼Ð¥Ü¦ì¸mÄ~Äò°õ¦æ
      R = R + 1: Y(Brr(i, 1) & "|" & V) = 1
      '¡ô¥ORÅܼƲ֥[1
      '¥O¦bY¦r¨å¸Ìªº(key:Brr°}¦C²Ä1Äæ¦r¦ê³s±µ"|",¦A³s±µVÅܼƩҲզ¨ªº¦r¦ê),
      'item="" §ï¬° 1,
      Crr(R, 1) = Brr(i, 1): Crr(R, 2) = V
      '¡ô¥ORÅܼƦC²Ä1ÄæCrr°}¦C¬O i°j°é¦C²Ä1ÄæBrr°}¦C­È,
      '¡ô¥ORÅܼƦC²Ä2ÄæCrr°}¦C¬O VÅܼÆ
v01: Next
Next
[E2].Resize(R, 2) = Crr
'¡ô¥O[E2]ÂX®i¦V¤URÅܼƦC,¦V¥kÂX®i2Äæ½d³òÀx¦s®æ­È¥HCrr°}¦C­È±a¤J
Set Y = Nothing: Erase Brr, Crr
'¡ô¥OÄÀ©ñÅܼÆ
End Sub