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

[µo°Ý] ¦p¦ó¨Ì§Ç¨ú¥X¦³©³¦âªº¸ê¦C¦C

[µo°Ý] ¦p¦ó¨Ì§Ç¨ú¥X¦³©³¦âªº¸ê¦C¦C

¦U¦ì¤j¤j

[Sheet1ªí]©M[Sheet2ªí]ªº¡uA:DÄæ¡v¦U¦³¼Æ¶q¤£¬Ûµ¥ªº¸ê®Æ¦C(¬ù200¦C), ¦p¦ó¥h§ì¨ú¸Ó¨âªí¡uB:DÄæ¡vÄ椤±a¦³¬õ©³»P¶À©³¬°¶¶§ÇªºÀx¦s®æ¨Ã½Æ»s¦Ü[Sheet3ªí]§Y¥ý¨ú¥X¬õ©³ªºÀx¦s®æ«á¦A¥h¨ú¥X¶À©³ªºÀx¦s®æ(¸Ô¦p[Sheet3ªí]©Ò¥Ü).
¨Ò¦p:
[Sheet1ªí]ªº¡uB:DÄæ¡v¦³3­Ó¬õ©³¸ê®Æ¦C©M4­Ó¶À©³¸ê®Æ¦C­n½Æ»s¦Ü[Sheet3ªí] ªº¡uA:CÄæ¡v
[Sheet2ªí]ªº¡uB:DÄæ¡v¦³3­Ó¬õ©³¸ê®Æ¦C©M6­Ó¶À©³¸ê®Æ¦C­n½Æ»s¦Ü[Sheet3ªí] ªº¡uD:EÄæ¡v

VBAÀ³¦p¦ó¼g¥X¨Ó

·Ð½Ð¥ý¶i ¤j¤j«ü¾É
TEST29A.rar (17.61 KB)

¦^´_ 1# luke
  1. Sub ex()
  2. Dim Rng As Range, A As Range
  3. k = 1
  4. For Each sh In Sheets(Array("sheet1", "sheet2"))
  5.    With sh
  6.    For i = 1 To 2
  7.    Set Rng = Nothing
  8.     For Each A In .Range(.[A1], .Cells(.Rows.Count, 1).End(xlUp))
  9.         If A.Interior.ColorIndex = i * 3 Then
  10.            If Rng Is Nothing Then Set Rng = A.Offset(, 1).Resize(, 3) Else Set Rng = Union(Rng, A.Offset(, 1).Resize(, 3))
  11.         End If
  12.      Next
  13.      r = Application.CountA(sheet3.Columns(k)) + 1
  14.    If Not Rng Is Nothing Then Rng.Copy sheet3.Cells(r, k)
  15.    Next
  16.    End With
  17.    k = k + 3
  18. Next
  19. End Sub
½Æ»s¥N½X
¾Ç®üµL²P_¤£®¢¤U°Ý

TOP

¦^´_ 2# Hsieh


ÁÂÁ¶Wª©µªÂÐ

­Y[Sheet3ªí]¦³¦X¨ÖªºÄæ¦ì¦pB:DÄæ(1Äæ)©MG:IÄæ(1Äæ), ­pºâÄæ¦ì®É·|²£¥Í1004¿ù»~.
1004A.jpg
§Y:
[Sheet1ªí]ªº¡uB:DÄæ¡v­n½Æ»s¦Ü[Sheet3ªí] ªº¡uAÄæ¡BBÄæ©MEÄæ¡v
[Sheet2ªí]ªº¡uB:DÄæ¡v­n½Æ»s¦Ü[Sheet3ªí] ªº¡uFÄæ¡BGÄæ©MJÄæ¡v

À³¦p¦ó­×§ï»yªk?
TEST29B.rar (19.24 KB)

TOP

¦^´_ 3# luke
  1. Sub ex()
  2. Dim Rng As Range, A As Range, Ar()
  3. k = 1
  4. For Each sh In Sheets(Array("sheet1", "sheet2"))
  5.    With sh
  6.    For i = 1 To 2
  7.    Set Rng = Nothing
  8.     For Each A In .Range(.[A1], .Cells(.Rows.Count, 1).End(xlUp))
  9.         If A.Interior.ColorIndex = i * 3 Then
  10.            ReDim Preserve Ar(s)
  11.            Ar(s) = Array(A, A.Offset(, 1), "", "", A.Offset(, 2))
  12.            s = s + 1
  13.         End If
  14.      Next
  15.      r = Application.CountA(sheet3.Columns(k)) + 1
  16.    If s > 0 Then
  17.       With sheet3.Cells(r, k).Resize(s, 5)
  18.          .Value = Application.Transpose(Application.Transpose(Ar)): Erase Ar: s = 0
  19.          .Interior.ColorIndex = i * 3
  20.       End With
  21.    End If
  22.    Next
  23.    End With
  24.    k = k + 5
  25. Next
  26. End Sub
½Æ»s¥N½X
¾Ç®üµL²P_¤£®¢¤U°Ý

TOP

¦^´_ 4# Hsieh


·PÁ¶Wª©µªÂÐ

°õ¦æ«áµo²{[Sheet3ªí]ªº¡uA:JÄæ¡v©ÒÅã¥ÜªºÄæ¦ì¦³ÂI¥X¤J,
½Ð°Ñ¨£ªþÀÉ¡iSheet3µ²ªG¡jªí©Ò¥Ü

·Ð½Ð«ü¾É­×¥¿»yªk
TEST29C.rar (26.14 KB)

TOP

¦^´_ 5# luke
  1.          §ï      Ar(s) = Array(A.Offset(, 1), A.Offset(, 2), "", "", A.Offset(, 3))
½Æ»s¥N½X
¨Ñ°Ñ¦Ò

TOP

        ÀR«ä¦Û¦b : ¦h°µ¦h±o¡C¤Ö°µ¦h¥¢¡C
ªð¦^¦Cªí ¤W¤@¥DÃD