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

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

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

·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
PKKO

TOP

·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]

TOP

¦^´_ 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.         For i = 1 To UBound(rng)

  3.             If rng(i, 5) = s Then '²Å¦Xªº­È

  4.                 m = m + 1

  5.                 ReDim Preserve arr(1 To UBound(rng, 2),1 To m)

  6.                 For j = 1 To UBound(rng, 2)

  7.                   arr(j, m) = rng(i, j)

  8.                 Next

  9.             End If

  10.         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

TOP

¥»©«³Ì«á¥Ñ PKKO ©ó 2014-11-19 02:22 ½s¿è

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

TOP

        ÀR«ä¦Û¦b : ¥ÌÄ@°µ¡BÅw³ß¨ü¡C
ªð¦^¦Cªí ¤W¤@¥DÃD