0分

個人積分：0分

文章編號：76818670

Excel VBA問題(抓取多個活頁簿進行vlookup)

想請問各位高手VBA相關問題
目前正在寫巨集，其功能為
將多個活頁簿的檔案(Ex:A/B/C/D)使用vlookup的方式整合到一個新的活頁簿中(Ex:甲)
所有的活頁簿都存放於同一個資料夾
希望巨集執行完後活頁簿甲如下圖
Excel VBA問題(抓取多個活頁簿進行vlookup)

以下則是我寫的巨集程式

Sub allfolder()
Dim tWB As Workbook
Set tWB = ThisWorkbook

Dim oWB As Object
Set oWB = ThisWorkbook.Sheets("output")

Dim folderpath As String
folderpath = ThisWorkbook.Path

Dim fileextension As String
fileextension = ".xlsm"

Dim filename As Variant
filename = Dir(folderpath & "\使用量*" & fileextension)

Application.ScreenUpdating = False

Do While filename <> " " '還需要修正
Dim targetbook As Workbook
Set targetbook = _
Workbooks.Open(folderpath & "\" & filename)

'針對開啟檔案要做的事情
'1.互V
oWB.Activate
Set currentcell = Range("A1")
For a = 1 To 200
For b = 1 To 50
Cells(currentcell.Column + a, 2+b) = "=VLOOKUP(RC1,[" & filename & "]InvData!C1:C50,button!R2C4,0)"
Next b
Next a
targetbook.Close
filename = Dir()
Loop
Application.ScreenUpdating = True
MsgBox "Done"
End Sub

巨集執行完後結果會變成所有的行列都是同一個檔案的資訊(Ex:活頁簿A)
猜想是迴圈的錯誤但不知該如何修改
請各位大大指點或是有無更好的做法?

謝謝各位QAQ

文章關鍵字

yunseed

37分

2樓

yunseed

個人積分：37分

文章編號：76819254

依你的程式碼來看，你的do while 是不是包在換行的迴圈外？你不是想先跑完A後再開B來跑嗎？你要不要試著拋出開的檔名，看是不是都只有最後一組的資料

meu00

0分

樓主

meu00

個人積分：0分

文章編號：76819513

yunseed wrote:
依你的程式碼來看，你(恕刪)

是的，我的巨集跑完後都會只剩最後一個檔案的資料
所以是Do迴圈擺放位置不對的問題嗎?

yunseed

37分

4樓

yunseed

個人積分：37分

文章編號：76820810

meu00 wrote:
是的，我的巨集跑完後...(恕刪)

你的流程應該是：迴圈B 開檔再包迴圈A 整理資料
但你實際的流程看來是：開檔後迴圈A再包迴圈B後關檔直到全部開過，所以你的資料就一直被重復蓋掉了。
另外我不瞭解你的a 跟b 數值的來源，但依你使用cells()的做法，看起來b就是你要開檔的量？

小小尉

222分

5樓

小小尉

個人積分：222分

文章編號：76821412

meu00 wrote:
想請問各位高手VBA...(恕刪)

vlookup直接給完整路徑不是就不用開檔了嗎

For迴圈設定的位置每個檔案都是給相同的位置，所以只會顯示最後一筆的資料，試著改成這樣。
這樣第一欄會顯示A檔案的資料200筆，第二欄會顯示B檔案的資料200筆...依此類推。


Sub allfolder() 
Dim tWB As Workbook
Set tWB = ThisWorkbook

Dim oWB As Object
Set oWB = ThisWorkbook.Sheets("output")

Dim folderpath As String
folderpath = ThisWorkbook.Path

Dim fileextension As String
fileextension = ".xlsm"

Dim filename As Variant
filename = Dir(folderpath & "\使用量*" & fileextension)

Application.ScreenUpdating = False
Dim b As Integer
b = 1
Do While filename <> " " '還需要修正
Dim targetbook As Workbook
Set targetbook = _
Workbooks.Open(folderpath & "\" & filename)

'針對開啟檔案要做的事情
'1.互V
oWB.Activate
Set currentcell = Range("A1")
For a = 1 To 200
'For b = 1 To 50
Cells(currentcell.Column + a, 2+b) = "=VLOOKUP(RC1,[" & filename & "]InvData!C1:C50,button!R2C4,0)"
'Next b
Next a
targetbook.Close
filename = Dir()
b = b+1
Loop
Application.ScreenUpdating = True
MsgBox "Done"
End Sub

meu00

0分

樓主

meu00

個人積分：0分

文章編號：76822854

小小尉 wrote:
vlookup直接給(恕刪)

成功了
謝謝你

dadac2021

0分

7樓

dadac2021

個人積分：0分

文章編號：81170788

本人不懂VBA, 不明白以下"使用量" ,"還需要修正"', "針對開啟檔案要做的事情'及"1.互V" 如何更改到我的檔案,
假如A檔案, B檔案,C檔案某一行的資料,放入D檔案的C/E/G/H列, VBA如何寫?

Dim filename As Variant
filename = Dir(folderpath & "\使用量*" & fileextension)

Application.ScreenUpdating = False
Dim b As Integer
b = 1
Do While filename <> " " '還需要修正
Dim targetbook As Workbook
Set targetbook = _
Workbooks.Open(folderpath & "\" & filename)
,
'針對開啟檔案要做的事情
'1.互V

Excel VBA問題(抓取多個活頁簿進行vlookup)

小惡魔新聞台

今日熱門文章 網友點擊推薦！

今日熱門文章　網友點擊推薦！