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

[µo°Ý] ¸ê®Æª½¦VÂà¾î¦V±Æ¦C

[µo°Ý] ¸ê®Æª½¦VÂà¾î¦V±Æ¦C

¤£¦n·N«ä¤S¨Ó¸ß°Ý¤F

§Ú±q¸ê®Æ®w§ì¥X¨Óªº¸ê®Æ¦pªþ¥óªº"­ì©l¸ê®Æ"©Ò¥Ü¡@§e²{ªº¬Oª½¦V±Æ¦C
­Y§Ú­n±N¸ê®ÆÂàÅܦ¨ªþ¥ó¤¤"Âà¸m«á"ªº¼Ë¤l
¤£ª¾¬O§_¦³¿ìªk¹F¨ì¡H

¦]¬°§Ú§ì¥X¨Óªº¸ê®Æ¦C¼Æ³£¹F¨ì¤W¸Uµ§
©Ò¥H¬O§Æ±æ¯à¦b·sªº sheet °µÂà¸m¡@¶¶«K«O¯d­ì©l¸ê®Æ¥i¥H°µ°Ñ¦Ò

­Y¥H A Äæ¨Ó·í§@¸s²Õ§@Âà¸m¡@«h A Ä檺"1"¡B"2"¡B"3"¦U¤À§O¬°¤@¸s²Õ
¼ÐÃD´N¥H"1"¡B"2"¡B"3"·í§@¼ÐÃD
­Y¥H B Äæ¨Ó·í§@¸s²Õ§@Âà¸m¡@«h B Ä檺"4"¡B"5"¡B"6"¦A·f°t A Ä檺"1"¡B"2"¡B"3"§@¬°¤@¸s²Õ
¼ÐÃD´N¥H"A-B"¨Ó·í§@¼ÐÃD¡@¦]¦¹¼ÐÃD´N¬O"1-4"¡B"1-5"¡B"1-6"¡B"2-4"¡B2-5"¡B"2-6"¡B"3-4"¡B"3-5"¡B"3-6"

§Æ±æ¥i¥HÀ°À°§Ú¡@ÁÂÁ¡ã

¸ê®Æ.zip (4.42 KB)

¦^´_ 1# Genie
¤ñ¸û°ò¦ªº¼gªk
  1. Sub oag()

  2. Range("g2:az20000").Clear  '¦¹¦æ¥i§R°£ ¥D­n¬O¥Î¨Ó²M°£¦h¾l­«½Æªº

  3. For uua = 1 To 3
  4.     For uub = 4 To 6
  5.             For uud = 2 To Range("a2").CurrentRegion.Rows.Count
  6.                 Select Case uua
  7.                     Case 1
  8.                     If Cells(uud, 1) = uua Then Cells(uud, uua + 22) = Cells(uud, 3)
  9.                     Select Case uub
  10.                         Case uub
  11.                         If Cells(uud, 1) = uua And Cells(uud, 2) = uub Then Cells(uud, uua + 21 + uub) = Cells(uud, 3)
  12.                     End Select
  13.                
  14.                     Case 2
  15.                     If Cells(uud, 1) = uua Then Cells(uud, uua + 22) = Cells(uud, 3)

  16.                     Select Case uub
  17.                         Case uub
  18.                         If Cells(uud, 1) = uua And Cells(uud, 2) = uub Then Cells(uud, uua + 23 + uub) = Cells(uud, 3)
  19.                     End Select
  20.                     Case 3
  21.                     If Cells(uud, 1) = uua Then Cells(uud, uua + 22) = Cells(uud, 3)
  22.                     Select Case uub
  23.                         Case uub
  24.                         If Cells(uud, 1) = uua And Cells(uud, 2) = uub Then Cells(uud, uua + 25 + uub) = Cells(uud, 3)
  25.                     End Select
  26.                 End Select
  27.             Next
  28.     Next
  29. Next
  30. For aaa = 1 To Range("a2").CurrentRegion.Rows.Count
  31.     For uus = 23 To 34
  32.         For uuk = 2 To Range("a2").CurrentRegion.Rows.Count
  33.             If Cells(2, uus) = "" Then
  34.                 Cells(2, uus).Select
  35.                 Selection.Delete Shift:=xlUp
  36.             End If
  37.         Next
  38.     Next
  39. Next

  40. End Sub
½Æ»s¥N½X

  ¦h°µ¦h·Q¦h¾Ç²ß¡A¤Ö¬Ý¤Ö¿ù¤Ö°g³~

  ¦h°µ=¦h¦h½m²ß¡A¦h¦h½s¼g¡C
  ¦h·Q=·Q·Q¬°¤°»ò¤H®aµ{¦¡­n¨º¼Ë¼g¡A¦pªG´«¦¨¦Û¤v¡A¤S·|«ç¼g¡C
  ¦h¾Ç²ß=¾Ç²ß¤H®aªºµo°Ý¨Ã¸Ñµª¡A¾Ç²ß¤H®aªº¼gªk

  ¤Ö¬Ý=¥u¬Ý¤£°µ¤]ªPµM

TOP

¥»©«³Ì«á¥Ñ GBKEE ©ó 2013-1-7 18:38 ½s¿è

¦^´_ 1# Genie
¸Õ¸Õ¬Ý
  1. Option Explicit
  2. Sub Ex()
  3.     Dim D(1 To 2) As Object, AR(), Rng As Range, i As Integer, K As Variant
  4.     Set D(1) = CreateObject("SCRIPTING.DICTIONARY")   '¦r¨åª«¥ó
  5.     Set D(2) = CreateObject("SCRIPTING.DICTIONARY")
  6.     Set Rng = Sheets("­ì©l¸ê®Æ").Range("a2")          'Àx¦s®æª«¥ó
  7.     Do
  8.         '1. ¨Ì·Ó A Äæ§@°Ï¤À¡A±N¸ê®Æ¥Ñª½¦V±Æ¦CÅܬ°¾î¦V±Æ¦C¡C
  9.         '2. ­Y¨Ì A Äæ§@°Ï¤À¡A´N¥H A Ä檺­È§@¬°¼ÐÃD¡C
  10.         If D(1).exists(Rng.Value) Then                      '¦r¨åª«¥ó.exists(Rng.Value) ÃöÁä¦r[¦s¦b] ±ø¥ó¦¨¥ß
  11.            AR = D(1)(Rng.Value)                             '°}¦C=¦r¨åª«¥ó(ÃöÁä¦r)ªº¤º®e
  12.            ReDim Preserve AR(UBound(D(1)(Rng.Value)) + 1)   '°}¦CÂX¥R¼W¥[¤@¤¸¯À
  13.            AR(UBound(AR)) = Rng.Cells(1, 3).Value           '°}¦C¼W¥[ªº¤¸¯À=CÄ檺¼Æ­È
  14.            D(1)(Rng.Value) = AR                             '¦r¨åª«¥ó(ÃöÁä¦r)ªº¤º®e=°}¦C
  15.         Else
  16.             D(1)(Rng.Value) = Array(Rng.Cells(1, 3).Value)  '¦r¨åª«¥ó(ÃöÁä¦r)ªº¤º®e=°}¦C
  17.         End If
  18.         '*********************************************
  19.         '1. ¨Ì·Ó B Äæ§@°Ï¤À¡A±N¸ê®Æ¥Ñª½¦V±Æ¦CÅܬ°¾î¦V±Æ¦C¡C
  20.         '2. ­Y¨Ì B Äæ§@°Ï¤À¡A´N¥H A-B Ä檺­È§@¬°¼ÐÃD
  21.         K = "'" & Rng & " - " & Rng.Cells(1, 2)
  22.         If D(2).exists(K) Then
  23.            AR = D(2)(K)
  24.            ReDim Preserve AR(UBound(D(2)(K)) + 1)
  25.            AR(UBound(AR)) = Rng.Cells(1, 3).Value
  26.            D(2)(K) = AR
  27.         Else
  28.             D(2)(K) = Array(Rng.Cells(, 3).Value)
  29.         End If
  30.         Set Rng = Rng.Offset(1)
  31.     Loop Until Rng = ""
  32.     With Sheets("sheet1")
  33.         .Cells.Clear
  34.         If D(1).Count > 0 Then
  35.             i = 1
  36.             For Each K In D(1).keys    'K= ¦r¨åª«¥ó(ÃöÁä¦r)
  37.                 .Cells(1, i) = K
  38.                 .Cells(2, i).Resize(UBound(D(1)(K)) + 1) = Application.WorksheetFunction.Transpose(D(1)(K))  'Ū¨ú¤º®e
  39.                 i = i + 1
  40.             Next
  41.         End If
  42.         If D(2).Count > 0 Then
  43.             i = 10
  44.             For Each K In D(2).keys
  45.                 .Cells(1, i) = K
  46.                 .Cells(2, i).Resize(UBound(D(2)(K)) + 1) = Application.WorksheetFunction.Transpose(D(2)(K))
  47.                 i = i + 1
  48.             Next
  49.         End If
  50.     End With
  51. End Sub
½Æ»s¥N½X

TOP

¦^´_ 2# mark15jill


ÁÂÁ¡ã
¤£¹LÁöµM¥i¥H¦¨¥\°µ¥X¨Ó¡@¦ý¦]§Úªº¸ê®Æ¶q«ÜÃe¤j
°õ¦æ°_¨Ó³t«×«D±`ºC¡@¤£ª¾¬O§_¦³§ïµ½¤èªk¡H
¦Ó¥B§Ú¤@¦¸¥u·|¿ï¾Ü¤@Äæ (A Äæ©Î B Äæ) ¨Ó°µ¤À²Õ
¨Ã¤£»Ý­n¤@¦¸´N±N¿ï¾Ü¨âÄ檺±¡ªp°õ¦æ¥X¨Ó
¥t¥~¡@¸ê®Æ¨C¦¸Âà¸m«áªºÄæ¦ì¥i¨ì¤T¡B¥|¤QÄæ
©Ò¥H§Ú§Æ±æ¯à¦b·s sheet °õ¦æÂà¸m«áªºµ²ªG
½Ð°Ý¦³¿ìªk¶Ü¡H

TOP

¦^´_ 3# GBKEE


ÁÂÁ¡ã¡@¦¨¥\°µ¥X§Ú·Q­nªº¸ê®Æ®æ¦¡¤F¡I¡I¡I
¤£¹L§Ú¤@¦¸¥u·|¿ï¾Ü¤@Äæ (A Äæ©Î B Äæ) ¨Ó°µ¤À²Õ
¨Ã¤£»Ý­n¤@¦¸´N±N¿ï¾Ü¨âÄ檺±¡ªp°õ¦æ¥X¨Ó
©Ò¥H¬O§_¦³¿ìªkÅý§Ú¤@¶}©l´N¿ï¾Ü­n¨Ï¥Î A Äæ©Î B Äæ¨Ó°µ¤À²ÕÂà¸m§Úªº¸ê®Æ©O¡H

TOP

¦^´_ 5# Genie
  1. Option Explicit
  2. Sub Ex()
  3.     Dim D As Object, AR(), Rng As Range, i As Integer, K As Variant, W As String
  4.     Do
  5.         W = InputBox("½Ð¿ï¾Ü: A Äæ§@°Ï¤À ©Î B Äæ§@°Ï¤À")
  6.         If W = "" Then Exit Sub                         '¨S¿é¤J:Â÷¶}µ{¦¡
  7.     Loop Until UCase(W) = "A" Or UCase(W) = "B"
  8.     Set D = CreateObject("SCRIPTING.DICTIONARY")        '¦r¨åª«¥ó
  9.     Set Rng = Sheets("­ì©l¸ê®Æ").Range("a2")            'Àx¦s®æª«¥ó
  10.     Do
  11.         If UCase(W) = "A" Then K = Rng.Value
  12.         If UCase(W) = "B" Then K = "'" & Rng & " - " & Rng.Cells(1, 2)
  13.         If D.exists(K) Then                             '¦r¨åª«¥ó.exists(Rng.Value) ÃöÁä¦r[¦s¦b] ±ø¥ó¦¨¥ß
  14.             AR = D(K)                                   '°}¦C=¦r¨åª«¥ó(ÃöÁä¦r)ªº¤º®e
  15.             ReDim Preserve AR(UBound(D(K)) + 1)         '°}¦CÂX¥R¼W¥[¤@¤¸¯À
  16.             AR(UBound(AR)) = Rng.Cells(1, 3).Value      '°}¦C¼W¥[ªº¤¸¯À=CÄ檺¼Æ­È
  17.             D(K) = AR                                   '¦r¨åª«¥ó(ÃöÁä¦r)ªº¤º®e=°}¦C
  18.         Else
  19.             D(K) = Array(Rng.Cells(1, 3).Value)         '¦r¨åª«¥ó(ÃöÁä¦r)ªº¤º®e=°}¦C
  20.         End If
  21.         Set Rng = Rng.Offset(1)
  22.     Loop Until Rng = ""
  23.     With Sheets("Âà¸m«á")
  24.         .Cells.Clear
  25.         If D.Count > 0 Then
  26.             i = 1
  27.             For Each K In D.keys    'K= ¦r¨åª«¥ó(ÃöÁä¦r)
  28.                 .Cells(1, i) = K
  29.                 .Cells(2, i).Resize(UBound(D(K)) + 1) = Application.WorksheetFunction.Transpose(D(K))  'Ū¨ú¤º®e
  30.                 i = i + 1
  31.             Next
  32.         End If
  33.     End With
  34. End Sub
½Æ»s¥N½X

TOP

¥»©«³Ì«á¥Ñ c_c_lai ©ó 2013-1-8 07:27 ½s¿è

¦^´_ 6# GBKEE
¦^´_ 5# Genie
GBKEE ª©¤j¦­¦w¡I
¤µ¦­Åª¤F "¸ê®Æª½¦VÂà¾î¦V±Æ¦C" µoı Idea ¤£¿ù¡A©ó¬O¥G
°£¤F­ì¥ýªº  "AÄæ¡BB Äæ" ¡A§Ú¤S¥[¤J¤F "AB Äæ" ¿ï¶µ¡C
¨Ó¨ú¼Ö¤@¤U¡A½Ð¤Å¨£©Ç¡I(§Ú¥t¼W¥[¤@¤u§@ªí³æ "´ú¸Õµ²ªG")
  1. Sub Ex2()
  2.     Dim D As Object, AR(), Rng As Range, i As Integer, K As Variant, W As String
  3.     Dim cts As Integer, nums As Integer
  4.    
  5.     '  Do
  6.     '      W = InputBox("½Ð¿ï¾Ü: A Äæ§@°Ï¤À ©Î B Äæ§@°Ï¤À")
  7.     '      If W = "" Then Exit Sub                         '  ¨S¿é¤J:Â÷¶}µ{¦¡
  8.     '  Loop Until UCase(W) = "A" Or UCase(W) = "B"
  9.     W = InputBox("½Ð¿ï¾Ü: A Äæ§@°Ï¤À ©Î B Äæ§@°Ï¤À¡B" & vbCrLf & "¥ç©Î¬O AB Äæ§@°Ï¤À")
  10.     If UCase(W) <> "A" And UCase(W) <> "B" And UCase(W) <> "AB" Then Exit Sub   '  ¨S¿é¤J:Â÷¶}µ{¦¡
  11.    
  12.     nums = IIf(UCase(W) = "AB", 2, 1)
  13.     Set D = CreateObject("Scripting.Dictionary")            '  ¦r¨åª«¥ó
  14.    
  15.     For cts = 1 To nums
  16.         Set Rng = Sheets("­ì©l¸ê®Æ").Range("a2")            '  Àx¦s®æª«¥ó
  17.         
  18.         Do
  19.            If UCase(W) = "AB" Then
  20.                 K = IIf(cts = 1, Rng.Value, "'" & Rng & " - " & Rng.Cells(1, 2))
  21.             Else
  22.                 K = IIf(UCase(W) = "A", Rng.Value, "'" & Rng & " - " & Rng.Cells(1, 2))
  23.             End If
  24.                
  25.             If D.exists(K) Then                             '  ¦r¨åª«¥ó.exists(Rng.Value) ÃöÁä¦r[¦s¦b] ±ø¥ó¦¨¥ß
  26.                 AR = D(K)                                   '  °}¦C=¦r¨åª«¥ó(ÃöÁä¦r)ªº¤º®e
  27.                 ReDim Preserve AR(UBound(D(K)) + 1)         '  °}¦CÂX¥R¼W¥[¤@¤¸¯À
  28.                 AR(UBound(AR)) = Rng.Cells(1, 3).Value      '  °}¦C¼W¥[ªº¤¸¯À=CÄ檺¼Æ­È
  29.                 D(K) = AR                                   '  ¦r¨åª«¥ó(ÃöÁä¦r)ªº¤º®e=°}¦C
  30.             Else
  31.                 D(K) = Array(Rng.Cells(1, 3).Value)         '  ¦r¨åª«¥ó(ÃöÁä¦r)ªº¤º®e=°}¦C
  32.             End If
  33.             Set Rng = Rng.Offset(1)
  34.         Loop Until Rng = ""
  35.     Next
  36.             
  37.     With Sheets("´ú¸Õµ²ªG")
  38.         .Cells.Clear
  39.             
  40.         If D.Count > 0 Then
  41.             i = 1
  42.             For Each K In D.keys                            '  K = ¦r¨åª«¥ó(ÃöÁä¦r)
  43.                 .Cells(1, i) = K
  44.                 .Cells(2, i).Resize(UBound(D(K)) + 1) = Application.WorksheetFunction.Transpose(D(K))  '  Åª¨ú¤º®e
  45.                 i = i + 1
  46.             Next
  47.         End If
  48.     End With
  49. End Sub
½Æ»s¥N½X

TOP

¦^´_ 1# Genie
  1. Sub ex()
  2. Dim A As Range, d As Object, j&, i%, s%, C$, Ky
  3. C = InputBox("¿é¤JÄæ¦ìA©ÎB", , "A")
  4. Set d = CreateObject("Scripting.Dictionary")
  5. With Sheet1
  6. j = 2
  7. Do Until .Cells(j, 1) = ""
  8.   Set A = .Cells(j, C)
  9.   s = Application.CountIf(.Range(A, A.End(xlDown)), A)
  10.   i = Application.CountIf(A.Resize(s, 1), .Cells(j, C)) '­pºâ³æµ§¸ê®Æ¶q
  11.   If C = "A" Then
  12.      d(A.Value) = A.Offset(, 2).Resize(i, 1).Value
  13.      Else
  14.      d(A.Offset(, -1) & "_" & A) = A.Offset(, 1).Resize(i, 1).Value
  15.   End If
  16. j = j + i
  17. Loop
  18. End With
  19. With Sheet2
  20. .UsedRange.Clear
  21. k = 1
  22. For Each Ky In d.keys
  23.    .Cells(1, k) = Ky
  24.    .Cells(2, k).Resize(i, 1) = d(Ky)
  25.    k = k + 1
  26. Next
  27. End With
  28. End Sub
½Æ»s¥N½X
¾Ç®üµL²P_¤£®¢¤U°Ý

TOP

¦^´_ 6# GBKEE
¦^´_ 7# c_c_lai


ÁÂÁ¡ã¡@µ{¦¡°õ¦æ°_¨Ó¨S¦³°ÝÃD¡I¡I¡I

¦A½Ð°Ý¡@­Y§Ú­nÂX¥RÄæ¦ì¡@¥Î C Äæ©Î D Äæ§@°Ï¤À
¦³¿ìªk¤p§ï³o­Óµ{¦¡´N°µ±o¨ì¶Ü¡H

ÁöµM¥Ø«e¥Î¤£¨ì¡@¦ý·Q¤F¸Ñ¥¼¨Ó¦³»Ý­n®É§Ú¥i¥H«ç¼Ë°µ§ï¼g
ÁÂÁ¡ã

TOP

¦^´_ 8# Hsieh


³o­Óµ{¦¡°õ¦æ°_¨Ó¡@¦³´X­Ó¼Æ¾Ú·|µLªkÂà¸m¦¨¥\
¥B·|¥X²{ ¡­N/A ªºÄæ¦ì
¦p¹Ï¬O¿ï A Äæ¶i¦æÂà¸m
¦b "1" Ä椤¤Ö¤F¤@­Ó¼Æ¾Ú¡@¦b "2" Ä椤¦h¤F #N/A
½Ð°Ý¦³¿ìªk§ïµ½¶Ü¡H
ÁÂÁ¡ã

TOP

        ÀR«ä¦Û¦b : ¥Ç¿ù¥XÄb®¬¤ß¡A¤~¯à²M²bµL·Ð´o¡C
ªð¦^¦Cªí ¤W¤@¥DÃD