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

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

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

¦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)

±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. Set myD = CreateObject("scripting.dictionary")
  9. Arr = Range("a2:c" & Cells(Rows.Count, "a").End(3).Row).Value

  10. '²M°£µ²ªGÄ檺¸ê®Æ
  11. Range("e2", Cells(Rows.Count, "f")).ClearContents

  12. For Each A In Range("b2:b" & Cells(Rows.Count, "b").End(3).Row).Value
  13.     For Each B In Split(A, Chr(10))
  14.    
  15.     '±NBÄæ¦h¦æÀx¦s®æ¤ºªº­È¤À³Î¨Ã¥N¤J°}¦C,
  16.     '¨Ï¥Î¦r¨åª«¥ó±N­«½Æ­È§R°£
  17.     If myD(B) = 1 Then GoTo 101
  18.         N = N + 1
  19.         Brr(N, 1) = B
  20.         myD(B) = 1
  21. 101:    Next B
  22. Next A
  23. [f2].Resize(N, 1) = Brr


  24. '"---"µê½u½d³ò¤ºªºµ{¦¡½X¦bBÄæ¦h¦æÀx¦s®æ¦³­«½Æ¸ê®Æ©ÎªÅ¦æ®É·|¥X²{°ÝÃD
  25. '-------------------------------------------------------

  26. '­pºâBÄæ¦h¦æÀx¦s®æ¤ºªº­ÈªºÁ`¼Æ¶q¨ÃÅã¥Ü©óCÄæ
  27. For i = 1 To UBound(Arr)
  28.     C = Split(Arr(i, 2), Chr(10))
  29.     UC = UBound(C) + 1
  30.     Arr(i, 3) = UC
  31. Next i
  32. [a2].Resize(UBound(Arr), 3) = Arr



  33. '±NAÄ檺¸ê®Æ¨ÌCÄ檺¦¸¼Æ¶K¦ÜEÄæ
  34. For j = 2 To UBound(Arr) + 1
  35.     Cells(j, 1).Copy _
  36.     Cells(Rows.Count, 5).End(xlUp).Offset(1, 0).Resize(Cells(j, 3), 1)
  37. Next j

  38. '-------------------------------------------------------

  39. 'CÄ檺¼Æ¦r¨Ï¥ÎªÌ¥Î¤£¨ì,¬G¦b³Ì«á²M°£CÄæ
  40. Columns(3).ClearContents

  41. '¶}±Ò¿Ã¹õ§ó·s
  42. Application.ScreenUpdating = True

  43. 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ÁÂ

¸Õ¸Õ
  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

TOP

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

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

TOP

¦^´_ 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

TOP

¦^´_ 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ÁÂ.

TOP

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

TOP

¦^´_ 6# hcm19522

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

TOP

ª`ÄÀªº³¡¤À¸Ñ°£¥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

TOP

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

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

TOP

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

°õ¦æ«e:


°õ¦æµ²ªG:



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
¥Î¦æ°Ê¸Ë¸mÂsÄý½×¾Â¾Ç²ß«Ü¤è«K,ÁÂÁ½׾¸gÀç¹Î¶¤
½Ð¤j®a¤@°_¤W½×¾Â¨Ó¥æ¬y

TOP

        ÀR«ä¦Û¦b : ¯u¥¿ªº·R¤ß¡A¬O·ÓÅU¦n¦Û¤vªº³oÁû¤ß¡C
ªð¦^¦Cªí ¤W¤@¥DÃD