我試圖從許多 XML 檔案中匯入一個值,實際上我可以讀取 XML 檔案并從“AK”列復制資料,但是當我嘗試從作業簿粘貼它時出現錯誤。
如果我可以在每個檔案回圈的列底部添加每個檔案的內容,那將是完美的。
這是我的代碼:
xCount = 1
xFile = Dir(xStrPath & "\*.xml")
desiredSheetName = Application.InputBox("Select any cell inside the target sheet: ", "Prompt for selecting target sheet name", Type:=8).Worksheet.Name
Do While xFile <> ""
Set xWb = Workbooks.OpenXML(xStrPath & "\" & xFile)
'problemes when I try to paste the data
xWb.Sheets(1).Columns("AK:AK").Copy Worksheets(desiredSheetName).Cells(xCount, 1)
xWb.Close False
xCount = desiredSheet.UsedRange.Rows.Count 2
xFile = Dir()
Loop
編輯 1 : 請注意,我硬編碼了所需作業表名稱“Feuil2”的名稱,它開始給我新代碼的選擇問題。
我仍然有訊息錯誤:索引不屬于選擇。
xFile = Dir(xStrPath & "\*.xml")
'desiredSheetName = Application.InputBox("Select any cell inside the target sheet: ", "Prompt for selecting target sheet name", Type:=8).Worksheet.Name
Do While xFile <> ""
Set xWb = Workbooks.OpenXML(xStrPath & "\" & xFile)
xCount = Worksheets("Feuil2").Cells(Rows.Count, 1).End(xlUp).Row
Debug.Print xCount
xWb.Sheets(1).Columns("AK:AK").Copy Worksheets("Feuil2").Cells(xCount, 1)
xWb.Close False
xFile = Dir()
Loop
提前致謝
uj5u.com熱心網友回復:
您的代碼混合了隱式和顯式參考:
xWb.Sheets(1).Columns("AK:AK").Copy Worksheets("Feuil2").Cells(xCount, 1)
Worksheets("Feuil2")隱式參考活動作業簿,即您之前打開的 xWb - 我假設 xWb 缺少 Feuil2 - 因此索引錯誤。
與xCount = Worksheets("Feuil2").Cells(Rows.Count, 1).End(xlUp).Row-相同-Rows.Count將回傳活動作業表中打開作業簿時可能為“Feuil1”的結果。
此外,我認為使用命名良好的變數會有所幫助 - 至少這樣會更容易發現錯誤。
試試這個:
Sub copyValuesFromFiles(xStrPath As String)
Dim wbTarget As Workbook, wsTarget As Worksheet
Dim wbSource As Workbook, wsSource As Worksheet
Set wbTarget = ThisWorkbook
Set wsTarget = wbTarget.Worksheets("Feuil2")
Dim firstEmptyRow As Long, cntSourceRows As Long
Dim xFile As String
xFile = Dir(xStrPath) 'adjust to your needs
Do While xFile <> ""
Set wbSource = Workbooks.OpenXML(xStrPath & "\" & xFile)
Set wsSource = wbSource.Sheets(1)
With wsTarget
firstEmptyRow = .Cells(.Rows.Count, 1).End(xlUp).Row 1 ' 1 because you want to write to the first empty row
End With
With wsSource.Columns("AK:AK")
cntSourceRows = .Cells(.Rows.Count, 1).End(xlUp).Row
End With
With wsTarget.Cells(firstEmptyRow, 1)
.Resize(cntSourceRows, 1).Value2 = wsSource.Columns("AK").Resize(cntSourceRows, 1).value2
End With
wbSource.Close False
xFile = Dir()
Loop
End Sub
轉載請註明出處,本文鏈接:https://www.uj5u.com/qita/329799.html
