[µo°Ý] Re : ½Ð±Ð : ¶i¶¥¿z¿ï¦ý¤£­n¿z¿ïÁôÂ꺸ê®Æ

ji5kimo

­ìpo... ¦]´«¨t²Î¤S¨S¿ìªkdownload zz5151353 ¦^ÂЪºªþ¥ó...
(­ìpo http://gb.twbts.com/index.php?topic=13242.0)

²{¦b¤SµLªk¶Ç°Tµ¹ zz5151353 ¤j, ´N¤Spo ¤@¦¸, ½Ð¦U¦ì°ª¤âÀ°¦£...

Sheet2, Sheet3 ¤À§O¦³ÁôÂÃ, ¦ý¥Ø«e¿z¿ï(Sam, Jeff, Joe)¥X³£¦³¨º¨Ç¸ê®Æ(JOB1-6, JOBA-D)

½Ð±Ð¬O«ç»ò±NÁôÂ꺸ê®Æ¤£·|³Q¿z¿ï¿z¥X¨Ó ? ÁÂÁÂ.

luckwind

¦^´_ 2# PD961A


    ½Ð°Ý¦pªG¬O¦h­ÓÄæ¦ì­n°µÁôÂ䣳Q¿z¿ï¥X¨Óªº¤è¦¡¬O§_¤]¬O¦p¦¹¡H
¦b¤U¹ï©óvba¤£¬O«ÜÁA¸Ñ¡A¯à¤£¯à»¡©ú¤§...

GBKEE

1. Ar(UBound(Ar)) = R.Value // Ar(s) = .Cells(B.Row, 1).Resize(, 8).Value


¦^´_ 8# ji5kimo

1. Ar(UBound(Ar)) = R.Value // Ar(s) = .Cells(B.Row, 1).Resize(, 8).Value
³o¦æ¥i¥H±N­I´ºÃC¦â¤]copy ¶i¥h¶Ü ?

Ar¬O°}¦C(Array) µLªk±N­I´ºÃC¦â¤]copy

2. A Äægroup ªº¸ê®Æ¦³¿ìªk¤@°_¶i¨Ó¶Ü ? ³o¼Ë¦ü¥G´N¨Sªk¥Îarray¤F ?

¤£¬O¤£¦æ  A ÄæÀx¦s®æ§A¥Î¦X¨Ö¨ÓÅã¥Ü¹ï¸ê®Æªº®»¨ú ¼W¥[¤F½ÆÂø©Ê

ji5kimo

GBKEE & Hsieh ¤j,
  ¦³¨â­Ó°ÝÃD...
  1. Ar(UBound(Ar)) = R.Value // Ar(s) = .Cells(B.Row, 1).Resize(, 8).Value
     ³o¦æ¥i¥H±N­I´ºÃC¦â¤]copy ¶i¥h¶Ü ?

  2. A Äægroup ªº¸ê®Æ¦³¿ìªk¤@°_¶i¨Ó¶Ü ? ³o¼Ë¦ü¥G´N¨Sªk¥Îarray¤F ?

ji5kimo

¤@ª½¨S¸Ñ¨M, ¤Wyahoo+¤]°Ý¤F¤@¦¸, ¤]¦]¦¹ÁÙ¨S¥æ®t...
­è¤W¨Ó¬Ý, «z~ ·PÁÂGBKEE ¸òHsieh ¨â¦ì¤j¤j^^

VBA ¤@ª½¨S¦³¦n¦n¾Ç²ß, ©Ò¥H³£¬O¥Î¤@¯ë»y¨¥ªº¤è¦¡¦b¼g...
©Ò¥H¨â¦ì¤j¤jªºµ{¦¡½X¥i¯à­nªáÂI®É¶¡®ø¤Æ, ¦A¦¸·PÁÂ~ : )

GBKEE

¦^´_ 5# Hsieh


   

Set A = Columns("D")

HsiehªO¥D §A¤ÖÂI¤@ÂI
Set A = .Columns("D")

1. Sub Ex()
   
2.     Dim Sh As Worksheet, W As Worksheet, R As Range, Ar()
   
3.     For Each Sh In Sheets(Array("Sam", "Jeff", "Joe"))
   
4.         Sh.Range("A5:H" & Rows.Count).Clear
   
5.         ReDim Preserve Ar(0)
   
6.         For Each W In Sheets(Array("Sheet1", "Sheet2", "Sheet3"))
   
7.             For Each R In W.Range("A1").CurrentRegion.SpecialCells(xlCellTypeVisible).Cells.Rows
   
8.                 If R.Cells(4) Like Sh.[d2] Then
   
9.                     Ar(UBound(Ar)) = R.Value
   
10.                     ReDim Preserve Ar(UBound(Ar) + 1)
    
11.                 End If
    
12.             Next
    
13.         Next
    
14.         ReDim Preserve Ar(UBound(Ar) - 1)
    
15.         If UBound(Ar) > 0 Then
    
16.             Sh.Range("b" & Rows.Count).End(xlUp)(2, 0).Resize(UBound(Ar) + 1, 8) = Application.Transpose(Application.Transpose(Ar))
    
17.         End If
    
18.     Next
    
19. End Sub

½Æ»s¥N½X

Hsieh

1. Sub Ex()
   
2. Dim A As Range, B As Range, Ar(), CTR$, s&, Sh As Worksheet, Sht As Worksheet
   
3. For Each Sht In Sheets(Array("Sam", "Jeff", "Joe"))
   
4. With Sht
   
5. .Cells.Clear
   
6. Sheet2.Rows(1).Copy .[A1]
   
7. CTR = .Name
   
8. .Rows(1).Find(Title, lookat:=xlWhole).Offset(1, 0) = "*" & CTR & "*"
   
9. For Each Sh In Sheets(Array("Sheet1", "Sheet2", "Sheet3"))
   
10.     With Sh
    
11.     ReDim Preserve Ar(s)
    
12.     Ar(s) = .[A1:H1].Value
    
13.     s = s + 1
    
14.        Set A = .Columns("D")
    
15.        For Each B In A.SpecialCells(xlCellTypeVisible).SpecialCells(xlCellTypeConstants)
    
16.            If InStr(B, CTR) > 0 Then ReDim Preserve Ar(s): Ar(s) = .Cells(B.Row, 1).Resize(, 8).Value: s = s + 1
    
17.        Next
    
18.     End With
    
19.     .[B65536].End(xlUp).Offset(2, -1).Resize(s, 8) = Application.Transpose(Application.Transpose(Ar))
    
20.     s = 0
    
21.     Erase Ar
    
22. Next
    
23. End With
    
24. Next
    
25. End Sub

½Æ»s¥N½X

GBKEE

PD961A, ÀɮרS¿ù, ¤§«e¤w½ÐªO¥DÀ°¦£download ¤F. ÁÂÁ : )
¦ýzz5151353 ¤j¨Ã¨S¦³¸Ñ»¡«ç»ò±NÁôÂ꺸ê®Æ¤£·| ...
ji5kimo µoªí©ó 2010-5-11 11:53

¤U¸ü (12.51 KB)

2010-6-16 14:22

¥Î¶i¶¥¿z¿ï¬O¤£¦æªº
Sheet1,Sheet2, Sheet3 ¤¤GroupÄæ½Ð¨ú®ø¦X¨ÖªºÀx¦s®æ

1. Sub Ex()
   
2.     Dim Sh As Worksheet, W As Worksheet, R As Range, Rng As Range
   
3.     For Each Sh In Sheets(Array("Sam", "Jeff", "Joe"))
   
4.         Sh.Range("A5:H" & Rows.Count).Clear
   
5.         For Each W In Sheets(Array("Sheet1", "Sheet2", "Sheet3"))
   
6.             Set Rng = Nothing
   
7.             For Each R In W.Range("A1").CurrentRegion.Rows
   
8.                 If Not R.Hidden And R.Cells(4) Like Sh.[d2] Then
   
9.                     If Rng Is Nothing Then
   
10.                         Set Rng = R
    
11.                     Else
    
12.                         Set Rng = Union(Rng, R)
    
13.                     End If
    
14.                 End If
    
15.             Next
    
16.             If Not Rng Is Nothing Then
    
17.                 Rng.Copy Sh.Range("b" & Rows.Count).End(xlUp)(2, 0)
    
18.             End If
    
19.         Next
    
20.     Next
    
21. End Sub

½Æ»s¥N½X

ji5kimo

PD961A, ÀɮרS¿ù, ¤§«e¤w½ÐªO¥DÀ°¦£download ¤F. ÁÂÁ : )
¦ýzz5151353 ¤j¨Ã¨S¦³¸Ñ»¡«ç»ò±NÁôÂ꺸ê®Æ¤£·|³Q¿z¿ï¿z¥X¨Ó ?
ÁٽЦU¦ìÀ°¦£, ÁÂÁÂ~

PD961A

­ìpo... ¦]´«¨t²Î¤S¨S¿ìªkdownload zz5151353 ¦^ÂЪºªþ¥ó...
(­ìpo http://gb.twbts.com/index.php?topic= ...
ji5kimo µoªí©ó 2010-5-11 09:57

±z¦n
À°±z¦^¨t²Îdownload zz5151353 ¦^ÂЪºªþ¥ó...
    TEST1¬O±zªºÂÂÀÉ
     TEST1-1¬Ozz5151353 ¦^ÂЪºªþ¥ó...
¤£¾å±o¬O±z­nªº¶Ü? test1.rar (13.61 KB)

¤U¸ü¦¸¼Æ: 16

2010-5-11 10:29

test1-1.rar (30.79 KB)

¤U¸ü¦¸¼Æ: 15

2010-5-11 10:29

ÁÂÁÂ!