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

[µo°Ý] ¦p¦ó±q¸ê®Æ§¨ªºExcelŪÀɼgÀÉ

[µo°Ý] ¦p¦ó±q¸ê®Æ§¨ªºExcelŪÀɼgÀÉ

¸ê®Æ§¨¸Ì¨C¤é³£·|·s¼W¤µ¤éªº¼Æ¾Ú
¤À§O¬°²Ä8Äæ¸ò²Ä19Äæ

¦pªG§Ú±o¸ê®Æ§¨¸ô®|¬OC:\Users\Rawdata

­n§â¸ê®Æ§¨¤ºªºÀÉ®×¥þ³¡¶]¤@¹M

¤À§O¨ú²Ä8Äæ¸ò²Ä19Äæ

ªþÀɦ³1­Ó¤ëªº¸ê®Æ

¤]¦³ªþ¤W§Ú¦X¨Ö°_¨Óªº®æ¦¡<¶]§¹ªºµ²ªG>

§Ú¥u¦³¨ú14¤Ñªº¸ê®Æ

½Ð°Ý¸Ó¦p¦ó°µ©O

¦]¬°§Ú¦³¤@¦~ªº¸ê®Æ­n¶]= " =




tt1900.zip (589.85 KB)

¦^´_ 1# starbox520
  1. Sub inputraw()
  2. ActiveSheet.UsedRange.Offset(1).ClearContents
  3. Application.ScreenUpdating = False
  4. fd = "C:\Users\Rawdata\" 'rawdataÀɮ׸ô®|
  5. fs = Dir(fd & "*")
  6. r = 2
  7. Do Until fs = ""
  8. With Workbooks.Open(fd & fs)
  9.    ActiveSheet.Cells(r, 1).Resize(, 21) = .ActiveSheet.Cells(8, 1).Resize(, 21).Value
  10.    ActiveSheet.Cells(r, 22).Resize(, 20) = .ActiveSheet.Cells(19, 2).Resize(, 20).Value
  11.    .Close 0
  12. End With
  13. fs = Dir
  14. r = r + 1
  15. Loop
  16. Application.ScreenUpdating = True
  17. End Sub
½Æ»s¥N½X
¾Ç®üµL²P_¤£®¢¤U°Ý

TOP

¦^´_ 2# Hsieh
¦^ª©¤j
§Ú¬O¥Î³oºØ¤èªk¥i¬O¦³«]­­¦bÁÙ­n³Ð¸ê®Æ§¨
ÁÙ¬O±zªº¦n¥Î«¢«¢
  1. Sub test()
  2.     Range("B2").Select
  3.     ActiveWindow.FreezePanes = True
  4.    
  5. Dim p, f, arr1, arr2, arr3, arr4,  dic
  6. Application.ScreenUpdating = False
  7. Set dic = CreateObject("scripting.dictionary")
  8. ActiveSheet.Range("B2:AO65535").ClearContents
  9.     For j = 2 To ActiveSheet.Range("A1").CurrentRegion.Rows.Count
  10.         dic(Cells(j, 1).Value) = j
  11.     Next

  12. p = ThisWorkbook.Path & "\rawdata\"
  13. f = Dir(p & "*.xls")

  14. Do While Len(f)
  15.     If f <> "" Then
  16.         With GetObject(p & f)
  17.             arr1 = .Sheets(2).Range("A2:A8")
  18.             arr2 = .Sheets(2).Range("B2:U8")
  19.             arr3 = .Sheets(2).Range("A13:A19")
  20.             arr4 = .Sheets(2).Range("B13:U19")
  21.             .Close SaveChanges:=False
  22.         End With
  23.     End If
  24.     With ThisWorkbook.ActiveSheet
  25.         For i = 1 To 7
  26.             If dic(arr1(i, 1)) <> "" Then
  27.                 .Range("B" & dic(arr1(i, 1))).Resize(1, UBound(arr2, 2)).Value = WorksheetFunction.Index(arr2, i, 0)
  28.                 'h1 = dic(arr2(i, 1))
  29.             
  30.             End If
  31.             If dic(arr3(i, 1)) <> "" Then
  32.                 .Range("v" & dic(arr3(i, 1))).Resize(1, UBound(arr4, 2)).Value = WorksheetFunction.Index(arr4, i, 0)
  33.             End If
  34.         Next
  35.     End With
  36.     f = Dir
  37. Loop
  38. Application.ScreenUpdating = True
  39. End Sub
½Æ»s¥N½X

TOP

        ÀR«ä¦Û¦b : ¶¢¤HµL¼Ö½ì¡A¦£¤HµL¬O«D¡C
ªð¦^¦Cªí ¤W¤@¥DÃD