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

[µo°Ý] Ãö©ó¸õ¦æªº°ÝÃD

[µo°Ý] Ãö©ó¸õ¦æªº°ÝÃD

½Ð°Ý¥H¤U³o²Õµ{¦¡½X
¬°¦ó§Ú­×§ï¤§«á¤@ª½¼g¦b¦P¤@¦æ¡A¤£·|©¹¤U¤@¦æ¼g¤J¤F

¨Ï¥Î¤èªk¬O: ¶}±Ò"¶×¥X"Excel  -> ¸Ì­±ÂI¿ï«ö¶s"¶×¥X"
´N·|°õ¦æ¸Ì­±ªºVBA¤F
VBA·|¥h§ä¥sRawdataªº¸ê®Æ§¨->¸Ì­±ªºEXCEL¤À§O¥´¶}->¨ú¸Ì­±§Ú­nªºÄæ¦ì¸ê®Æ ->¤@ª½¨ì³Ì«á¤@­ÓEXCEL
  1. Sub TT()
  2. Dim Mypa$, workName$, brr(1), rr, br
  3. Const sWm As String = "\Rawdata\"
  4. t = Timer
  5. Mypa = ThisWorkbook.Path & sWm
  6. workName = Dir(Mypa & "*.xls")
  7. Sheet1.UsedRange.Offset(1).ClearContents
  8. Application.ScreenUpdating = False
  9. Do Until workName = ""
  10.     With GetObject(Mypa & workName)
  11.         n = n + 1
  12.         With .Sheets("Data")
  13.             brr(0) = .Range("a8").Resize(1, 21)
  14.             brr(1) = .Range("b19").Resize(1, 20)
  15.         End With
  16.         .Close False
  17.     End With
  18.     rr = brr(0): br = brr(1)
  19.     With Sheet1
  20.          i = .Cells(Rows.Count, 1).End(3).Row + 1
  21.         .Range("c" & i).Resize(1, 21) = rr
  22.         .Range("x" & i).Resize(1, 20) = br
  23.     End With
  24.     Erase brr()
  25.     workName = Dir
  26. Loop
  27. Application.ScreenUpdating = True
  28. MsgBox "¦@ªá" & Format(Timer - t, "0.000") & "¬í" _
  29.     & Chr(10) & "§ä¨ì " & n & "µ§¸ê®Æ", vbOKCancel + vbInformation
  30. End Sub
½Æ»s¥N½X
À³¸Ó­n³o¼Ë§e²{

¦Ó¤£¬O¤@ª½¦b¦P¤@¦æ§e²{...(·íµM³Ì«á¥u¦³³Ì«á§ä¨ìªº¤@µ§ªºµ²ªG)


§Ú¼g¤Jªº¦a¤è¦b³o¸Ì
  1. With Sheet1
  2.          i = .Cells(Rows.Count, 1).End(3).Row + 1
  3.         .Range("c" & i).Resize(1, 21) = rr
  4.         .Range("x" & i).Resize(1, 20) = br
  5.     End With
½Æ»s¥N½X
TEST.rar (155.66 KB)

¦^´_ 1# starbox520
  1. Option Explicit

  2. Sub TT()
  3.     Dim Mypa$, workName$, brr(1), pos As Long
  4.     Dim t As Date, n As Long
  5.    
  6.     Const sWm As String = "\Rawdata\"
  7.     t = Timer
  8.     n = 0
  9.     Mypa = ThisWorkbook.Path & sWm
  10.     workName = Dir(Mypa & "*.xls")
  11.     Sheet1.UsedRange.Offset(1).ClearContents
  12.    
  13.     Application.ScreenUpdating = False
  14.     Do Until workName = ""
  15.         'With GetObject(Mypa & workName)
  16.         With Workbooks.Open(Mypa & workName)
  17.             n = n + 1
  18.             With .Sheets("Data")
  19.                 brr(0) = .Range("a8").Resize(1, 21)
  20.                 brr(1) = .Range("b19").Resize(1, 20)
  21.             End With
  22.             .Close False
  23.         End With
  24.         
  25.         With Sheet1
  26.             pos = .Cells(Rows.Count, 3).End(3).Row + 1
  27.             .Range("c" & pos).Resize(1, 21) = brr(0)
  28.             .Range("x" & pos).Resize(1, 20) = brr(1)
  29.         End With
  30.         Erase brr()
  31.         workName = Dir
  32.     Loop
  33.     Application.ScreenUpdating = True
  34.     MsgBox "¦@ªá" & Format(Timer - t, "0.000") & "¬í" _
  35.             & Chr(10) & "§ä¨ì " & n & "µ§¸ê®Æ", vbOKCancel + vbInformation
  36. End Sub
½Æ»s¥N½X

TOP

¦^´_ 2# c_c_lai


    ÁÂÁÂC¤j¤ÀªR
   
    À´¤FXD

TOP

        ÀR«ä¦Û¦b : ¡i¦æµ½­n¤Î®É¡j¦æµ½­n¤Î®É¡A¥\¼w­n«ùÄò¡C¦p¿N¶}¤ô¤@¯ë¡A¥¼¿N¶}¤§«e¤d¸U¤£­n°±º¶¤õ­Ô¡A§_«h­«¨Ó´N¤Ó¶O¨Æ¤F¡C
ªð¦^¦Cªí ¤W¤@¥DÃD