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

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

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

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

¦^´_ 11# Hsieh


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

TOP

¦^´_ 12# softsadwind


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

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

ÁÂÁ½׾Â,ÁÂÁ¦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

        ÀR«ä¦Û¦b : ¤ß¤¤±`¦sµ½¸Ñ¡B¥]®e¡B·P«ä¡Bª¾¨¬¡B±¤ºÖ¡C
ªð¦^¦Cªí ¤W¤@¥DÃD