麻辣家族討論版版 » Excel程式區 » 多筆excel資料整理到新的excel檔

返回列表下一主題上一主題發帖

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

小學生 Rank: 1

帖子: 2
主題: 1
精華: 0
積分: 3
點名: 0
作業系統: win7
軟體版本: 2010
閱讀權限: 10
註冊時間: 2014-11-20
最後登錄: 2018-4-10

1^# 跳轉到 » 倒序看帖

字體大小: tT

發表於 2014-11-20 16:45 | 只看該作者

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

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

且excel內容如下圖

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

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

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

收藏

高中生 Rank: 3 Rank: 3

帖子: 835
主題: 6
精華: 0
積分: 915
點名: 16
作業系統: Win 10,7
軟體版本: 2019,2013,2003
閱讀權限: 50
性別: 男
註冊時間: 2010-5-3
最後登錄: 2024-11-14

2^#

發表於 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

複製代碼

小學生 Rank: 1

帖子: 2
主題: 1
精華: 0
積分: 3
點名: 0
作業系統: win7
軟體版本: 2010
閱讀權限: 10
註冊時間: 2014-11-20
最後登錄: 2018-4-10

3^#

發表於 2014-11-22 23:11 | 只看該作者

回復 2# luhpro

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

高中生 Rank: 3 Rank: 3

帖子: 835
主題: 6
精華: 0
積分: 915
點名: 16
作業系統: Win 10,7
軟體版本: 2019,2013,2003
閱讀權限: 50
性別: 男
註冊時間: 2010-5-3
最後登錄: 2024-11-14

4^#

發表於 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")

靜思自在 : 待人退一步，愛人寬一寸，就會活得很快樂。

返回列表下一主題上一主題