[發問] 多筆excel資料整理到新的excel檔

smart00361

把多筆excel名稱為數字(如下圖)且不連續的檔案整合到同一個excel檔
(多筆excel檔案內容格式都一樣，只有數值不同)

下載 (80.85 KB)

2014-11-20 16:05

且excel內容如下圖

下載 (27.95 KB)

2014-11-20 16:32

想把每筆excel的B87:B107的資料轉置到新的excel檔
並把B106:B287做平均取值也複製到新的excel檔(結果如下圖)

下載 (209 KB)

2014-11-20 16:42

綠色為多筆資料的檔名，黃色為B106:B287做平均取值，紅色為B87:B107的轉置資料

麻煩大大解答了~! 這對小弟很重要

luhpro

把多筆excel名稱為數字(如下圖)且不連續的檔案整合到同一個excel檔
(多筆excel檔案內容格式都一樣，只有數 ...
smart00361 發表於 2014-11-20 16:45

1. Sub nn()
   
2.   Dim lRow&
   
3.   Dim sFlNm$
   
4.   Dim shTar As Worksheet
   
5.   
   
6.   Set shTar = ThisWorkbook.Sheets(1)
   
7.   With shTar
   
8.     .Cells.Clear
   
9.     .[A1].Select
   
10.   End With
    
11.   sFlNm = Dir("*.xls")
    
12.   lRow = 2
    
13.   Do While sFlNm <> ""
    
14.     With Workbooks.Open(sFlNm, , 1)
    
15.       shTar.Activate
    
16.       With .Sheets(1).Cells(lRow, 1)
    
17.         shTar.Cells(lRow, 1) = Left(sFlNm, Len(sFlNm) - 4)
    
18.         shTar.Cells(lRow, 2) = Application.Sum(.Parent.Range("B106:B287")) / 182
    
19.         .Range("B87:B107").Copy
    
20.         shTar.Cells(lRow, 3).PasteSpecial Transpose:=True
    
21.       End With
    
22.       .Close False
    
23.     End With
    
24.     sFlNm = Dir
    
25.     lRow = lRow + 1
    
26.   Loop
    
27. End Sub

複製代碼

smart00361

回復 2# luhpro

大大謝謝您，關於上面的code 我找不到讀檔路徑，請問需要修改哪裡?

luhpro

回復  luhpro

大大謝謝您，關於上面的code 我找不到讀檔路徑，請問需要修改哪裡?
smart00361 發表於 2014-11-22 23:11

Dim sPath$

插在第 11 行前面 :

sPath = "C:\test"
ChDrive sPath
ChDir sPath
sFlNm = Dir("*.xls")