麻辣家族討論版版 - Powered by Discuz! Board

標題: [發問] 多筆excel資料整理到新的excel檔 [打印本頁]

作者: smart00361 時間: 2014-11-20 16:45 標題: 多筆excel資料整理到新的excel檔

把多筆excel名稱為數字(如下圖)且不連續的檔案整合到同一個excel檔
(多筆excel檔案內容格式都一樣，只有數值不同)
[attach]19598[/attach]
且excel內容如下圖
[attach]19599[/attach]
想把每筆excel的B87:B107的資料轉置到新的excel檔
並把B106:B287做平均取值也複製到新的excel檔(結果如下圖)
[attach]19601[/attach]
綠色為多筆資料的檔名，黃色為B106:B287做平均取值，紅色為B87:B107的轉置資料

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

作者: luhpro 時間: 2014-11-22 01:36

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

Sub nn()
Dim lRow&
Dim sFlNm$
Dim shTar As Worksheet
Set shTar = ThisWorkbook.Sheets(1)
With shTar
.Cells.Clear
.[A1].Select
End With
sFlNm = Dir("*.xls")
lRow = 2
Do While sFlNm <> ""
With Workbooks.Open(sFlNm, , 1)
shTar.Activate
With .Sheets(1).Cells(lRow, 1)
shTar.Cells(lRow, 1) = Left(sFlNm, Len(sFlNm) - 4)
shTar.Cells(lRow, 2) = Application.Sum(.Parent.Range("B106:B287")) / 182
.Range("B87:B107").Copy
shTar.Cells(lRow, 3).PasteSpecial Transpose:=True
End With
.Close False
End With
sFlNm = Dir
lRow = lRow + 1
Loop
End Sub

複製代碼

作者: smart00361 時間: 2014-11-22 23:11

回復 2# luhpro

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

作者: luhpro 時間: 2014-11-23 03:21

本帖最後由 luhpro 於 2014-11-23 03:22 編輯

回復 luhpro

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

Dim sPath$

插在第 11 行前面 :

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

歡迎光臨麻辣家族討論版版 (http://forum.twbts.com/)