ªð¦^¦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)

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

°õ¦æ«e:


¿é¤Jµ¡¿é¤J"A":


¿é¤Jµ¡¿é¤J"B":



Option Explicit
Sub TEST()
Dim Brr, Crr(1 To 1000, 1 To 1), A, Y, strNo1, R&, C%, i&, T1$, T2$, T3$, TT$
Dim xR As Range, Sh1 As Worksheet, Sh2 As Worksheet
strNo1 = InputBox("¿é¤JÄæ¦ìA©ÎB", , "A")
If StrPtr(strNo1) = 0 Or InStr("/A/B/", "/" & strNo1 & "/") = 0 Then Exit Sub
Set Y = CreateObject("Scripting.Dictionary")
Set Sh1 = Sheets("­ì©l¸ê®Æ"): Set xR = Sh1.[A1].CurrentRegion: Brr = xR
Set Sh2 = Sheets("Âà¸m«á"): Sh2.UsedRange.Clear
For i = 2 To UBound(Brr)
   T1 = Brr(i, 1): T2 = Brr(i, 2): T3 = Brr(i, 3)
   TT = Switch(strNo1 = "A", T1, strNo1 = "B", T1 & "-" & T2)
   A = Y(TT)
   If Not IsArray(A) Then A = Crr: C = C + 1: Y(TT & "|c") = C
   R = Y(TT & "|r"): R = R + 1: Y(TT & "|r") = R
   A(R, 1) = T3
   Y(TT) = A
Next
For Each A In Y.keys
   If IsArray(Y(A)) Then
      Sh2.Cells(1, Y(A & "|c")) = "'" & A
      Sh2.Cells(2, Y(A & "|c")).Resize(Y(A & "|r"), 1) = Y(A)
   End If
Next
Set Y = Nothing: Set xR = Nothing: Erase Brr, Crr
Set Sh1 = Nothing: Set Sh2 = Nothing
End Sub
¥Î¦æ°Ê¸Ë¸mÂsÄý½×¾Â¾Ç²ß«Ü¤è«K,ÁÂÁ½׾¸gÀç¹Î¶¤
½Ð¤j®a¤@°_¤W½×¾Â¨Ó¥æ¬y

TOP

¦^´_ 11# Hsieh
¦^´_ 14# Genie
Hsieh ª©¤j·s¦~´r§Ö¡I
¸g´ú¸Õµo²{¦³ÂI¤p·åÒ¯¡A­×§ï¤F¤@ÂI
  1. '  s = Application.CountIf(.Range(A, A.End(xlDown)), A)
  2. s = Application.CountIf(.Range("A" & j, .[A2].End(xlDown)), .Cells(j, "A"))
½Æ»s¥N½X
¹Lµ{¦pªþ¹Ï¡G

TOP

¦^´_ 12# softsadwind


¤@¶}©l Hsieh ¶W¯Åª©¥D´£¨Ñªºµ{¦¡°õ¦æ°_¨Ó·|¦³¤@ÂI°ÝÃD
°õ¦æ¥X¨Óªºµ²ªG¥i¥H¥h¤ñ¹ï­ì©l¸ê®Æ¡@·|µo²{¦³´X­Ó¼Æ­È¬O¨S¦³Âà¸m¦¨¥\ªº¡I

TOP

¦^´_ 11# Hsieh


¨S¿ù¡I¡@¸ê®Æ¶q¨CÄæ³£¤£¦P
¤£¹L³o­Óµ{¦¡¸Ñ¨M¤F³o­Ó°ÝÃD
«D±`ÁÂÁ¡ã

TOP

¦^´_ 10# Genie


    §Ú´ú¸Õ°_¨Óªºµ²ªG¬Ookªº»¡....
    123.gif

¥t¥~¤@­Ó°ÝÃD­n½Ð±Ð¦U¦ì¤j¤j
·íd1 ªºitem¹L¦hªº®É­Ô
.[A2].Resize(d1.Count, 6) = Application.Transpose(Application.Transpose(d1.items))
¥L¦bÂà´«ªº®É­Ô´N·|¥X²{«¬ºA¤£²Å
ºI¹Ï 20130108160934 (2).png

¹Á¸Õ§ârow §ï¦b 500¤§¤º¡A´N¥i¥Hª½±µ.[A2].Resize(d1.Count, 6) = Application.Transpose(Application.Transpose(d1.items))

¥u¦n¥Î§Oªº¤è¦¡³B²z
    For Each E In D.items
        
           E.Copy Sheets("Last - N").Range("A" & Rows.Count).End(xlUp).Offset(1)
        
    Next

¤£ª¾¹D¦³¤H¥i¥H«üÂI§ó¤è«Kªº¤è¦¡¶Ü¡H
50 ¦r¸`¥H¤º
¤£¤ä«ù¦Û©w¸q Discuz! ¥N½X

TOP

¦^´_ 10# Genie
¸ê®Æ·|¦³¨CÄ椣¦P¸ê®Æ¶q¶Ü?
¸Õ¸Õ¼g¤J®É¨Ì¦U¸s²Õ¸ê®Æ¶q¼g¤J
  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(UBound(d(Ky)), 1) = d(Ky)

  25.    k = k + 1

  26. Next

  27. End With

  28. End Sub
½Æ»s¥N½X
¾Ç®üµL²P_¤£®¢¤U°Ý

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

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

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

        ÀR«ä¦Û¦b : ­n§åµû§O¤H®É¡A¥ý·Q·Q¦Û¤v¬O§_§¹¬üµL¯Ê¡C
ªð¦^¦Cªí ¤W¤@¥DÃD