[µo°Ý] ¦p¦ó¦bsheet1¬d¸ß¸ê®Æ«á¿é¥X¨ìsheet2ªº¯S©w¦ì¸m(³z¹L°}¦C)

PKKO

·Q½Ð±Ð¤@¤U,°}¦Cªº¥Îªk,°ÝÃD¦pªþµùªº»¡©ú

1. Dim arr(), rng, s$, Num1%
   
2. Sub ex()
   
3.     Num1 = WorksheetFunction.CountA(Sheets("sheet2").Range("B:B"))
   
4.         s = 6
   
5.         rng = [A1].CurrentRegion
   
6.         For i = 1 To UBound(rng)
   
7.             If rng(i, 5) = s Then '²Å¦Xªº­È
   
8.                 m = m + 1
   
9.                 '¬°¦ó³o¦æªº1 To m·|¿ù»~
   
10.                 ReDim Preserve arr(1 To m, 1 To UBound(rng, 2))
    
11.                 For j = 1 To UBound(rng, 2)
    
12.                   arr(m, j) = rng(i, j)
    
13.                 Next
    
14.             End If
    
15.         Next
    
16.       
    
17.         
    
18.     '³o¬O±Nsheet2±qA1¶}©l¶K¤W,¦p¦ó§ï¦¨±qsheet2ªºBÄ檺Num1+1¶}©l¶K¤W©O?
    
19.     With Sheets("sheet2").[A1].Resize(UBound(arr) + 1, UBound(arr, 2) + 1)
    
20.         .Value = arr
    
21.         .EntireColumn.AutoFit
    
22.     End With
    
23.    
    
24. End Sub

½Æ»s¥N½X

PKKO

¤p§Ì­è­èª¦¤å,¥Ø«e¥u¾Ç·|¤F(«D°}¦C¤è¦¡)ªº¤èªk
¦ýÁÙ¬O·Q°Ý¤@¤U¤j¤j­Ì.³oºØ¤è¦¡­n¦p¦ó¥u¶K¤W­È?¦p¦ó¶K¨ì«ü©wÀx¦s®æ¨Ò¦pb3,¦Ó«D±qA1¶}©l¶K

1. '­«·s¿z¿ï«ü©w¤é´Á
   
2.      With Sheets("·|­û¸ê®Æ")
   
3.         .AutoFilterMode = False
   
4.         With [A1].CurrentRegion
   
5.             .AutoFilter 31, DD  '¿z¿ï«ü©w¤é
   
6.             .AutoFilter 12, "²Ä" & manyCar & "¨®"  '¿z¿ï¤½¥q¨®
   
7.             .Copy '½Æ»s
   
8.         End With
   
9.         
   
10.         With Sheets("«ü©w¬~")
    
11.               .Paste '¶K¤W
    
12.         End With
    
13.         .AutoFilterMode = False
    
14.     End With
    
15.     Application.CutCopyMode = xlCopy '²M°£°Å¶Kï

½Æ»s¥N½X

luhpro

·Q½Ð±Ð¤@¤U,°}¦Cªº¥Îªk,°ÝÃD¦pªþµùªº»¡©ú...
'¬°¦ó³o¦æªº1 To m·|¿ù»~
ReDim Preserve arr(1 To m, 1 To UBound(rng, 2))
...
PKKO µoªí©ó 2014-11-18 00:34

ReDim ¥u¯à¼W´î³Ì«á¤@­Ó¬W¼Ð

'³o¬O±Nsheet2±qA1¶}©l¶K¤W,¦p¦ó§ï¦¨±qsheet2ªºBÄ檺Num1+1¶}©l¶K¤W©O?
With Sheets("sheet2").[A1].Resize(UBound(arr) + 1, UBound(arr, 2) + 1)

With Sheets("sheet2").Cells(Num + 1, 2).Resize(UBound(arr) + 1, UBound(arr, 2) + 1)

¤p§Ì­è­èª¦¤å,¥Ø«e¥u¾Ç·|¤F(«D°}¦C¤è¦¡)ªº¤èªk
¦ýÁÙ¬O·Q°Ý¤@¤U¤j¤j­Ì.³oºØ¤è¦¡­n¦p¦ó¥u¶K¤W­È?¦p¦ó¶K¨ì«ü©w ...
PKKO µoªí©ó 2014-11-18 06:30

Àx¦s®æªí¥Ü¤è¦¡:
[Äæ¦W¦C¦W] ¦p [A1]
Cells(¦C¸¹,Ä渹) : Cells(7,2)=[B7]

PKKO

¦^´_ 3# luhpro


    luhpro ¤j±zªº·N«ä¬O»¡:ReDim ¥u¯à¼W´î³Ì«á¤@­Ó¬W¼Ð,©Ò¥H¤Gºû°}¦C¥u¯à¼W´î²Ä¤Gºûªº³¡¤À,¤@ºû°}¦C«h¨S¦³³o­Ó°ÝÃDÅo?
¨º§Ú­ì¥»ªºµ{¦¡½X,°}¦Cªº­È»Pcells­è¦n¬O¤Ï¹L¨Óªº,­n¦p¦óÂà¦^¨Ó?

1. rng = [A1].CurrentRegion
   
2. 
   
3.         For i = 1 To UBound(rng)
   
4. 
   
5.             If rng(i, 5) = s Then '²Å¦Xªº­È
   
6. 
   
7.                 m = m + 1
   
8. 
   
9.                 ReDim Preserve arr(1 To UBound(rng, 2),1 To m)
   
10. 
    
11.                 For j = 1 To UBound(rng, 2)
    
12. 
    
13.                   arr(j, m) = rng(i, j)
    
14. 
    
15.                 Next
    
16. 
    
17.             End If
    
18. 
    
19.         Next

½Æ»s¥N½X

With Sheets("sheet2").Cells(Num + 1, 2).Resize(UBound(arr) + 1, UBound(arr, 2) + 1)
§Ú¾Ç°_¨Ó¤F,·P®¦,¦]¬°¤p§Ì¤£¤ÓÀ´Resizeªº¥Îªk

With Sheets("«ü©w¬~")

              .Paste '¶K¤W

        End With

¥i¥Hª½±µ¥Î.cells(x,y)ªº¤è¦¡±µµÛ¶K¤Wªº¸Ü,¨º¤Ó¤è«K¤F,§Ú«Ý·|¸Õ¸Õ¬Ý

PKKO

¦^´_ 3# luhpro
¤j¤j§Ú¦¨¥\¤F,¥i¥H³z¹L°}¦Cªº¤è¦¡ª½±µ¿z¿ï,¨Ã¥B±N­È¿é¥X¨ì¥ô·Nsheet¤ºªº¥ô·N¦ì¸m

1. Sub ex()
   
2. Num1 = WorksheetFunction.CountA(Sheets("sheet2").Range("B:B"))
   
3. 
   
4.      Dim arr(), rng, ar
   
5.     rng = [A1].CurrentRegion
   
6.         For i = 1 To UBound(rng) '¶]¨C¤@¦C
   
7.           'If i = 1 Or rng(i, 2) Like 3 Then '¶]²Ä¤@¦C©Î¬O²Å¦Xªº­È
   
8.             If rng(i, 2) Like 3 Then '¶]²Å¦Xªº­È
   
9.             m = m + 1
   
10.             'ÃöÁä1:¥u¦³³Ì«á¤@ºû¥i¥HReDim
    
11.             ReDim Preserve arr(1 To UBound(rng, 2), 1 To m)
    
12.             For j = 1 To UBound(rng, 2)
    
13.               arr(j, m) = rng(i, j)
    
14.             Next
    
15.           End If
    
16.         Next  
    
17.   ar = Application.Transpose(arr)'ÃöÁä2:¬O¥i¥H¥ÎÂà¸mªº³o­Ó¤èªk
    
18.      'Sheets("Sheet2").Cells.ClearContents
    
19.     '¦bBÄ檺³Ì¤U¤è¶}©l¶K¤W
    
20.     With Sheets("sheet2").Cells(Num1 + 1, 2).Resize(UBound(ar), UBound(ar, 2))
    
21.         .Value = ar
    
22.         .EntireColumn.AutoFit
    
23.     End With
    
24.    
    
25.     Sheets("Sheet2").Activate
    
26. End Sub

½Æ»s¥N½X