因此，背景故事，我目前正在將三個 .txt 檔案復制并粘貼到每張紙各自的列中。但是，我有大量資料，因此將三個 .txt 檔案復制并粘貼到每個作業表各自的列中非常耗時。當我右鍵單擊作業表將其洗掉時，我看到了“查看代碼”按鈕。令我驚訝的是，我看到了將這個程序自動化以節省大量時間的機會。我看到了一個愿景
- 指定我正在復制和粘貼的 .txt 檔案的路徑名
- 指定要粘貼 .txt 檔案的全部內容的列
話雖如此，以下是我想在 Excel 中使用 VBA 系統完成的示例
首先，這里有 9 個 .txt 檔案可以匯入到作業表中：
TxtFile1Sheet1.txt
Cow1
Rabbit1
Deer1
Crab1
Goat1
Ducks1
TxtFile2Sheet1.txt
Vegetables1
Eggs1
Meat1
Poultry1
Fish1
Seeds1
TxtFile3Sheet1.txt
Fiction1
Narrative1
Novel1
Thriller1
Mystery1
Poetry1
TxtFile1Sheet2.txt
Cow2
Rabbit2
Deer2
Crab2
Goat2
Ducks2
TxtFile2Sheet2.txt
Vegetables2
Eggs2
Meat2
Poultry2
Fish2
Seeds2
TxtFile3Sheet2.txt
Fiction2
Narrative2
Novel2
Thriller2
Mystery2
Poetry2
TxtFile1Sheet3.txt
Cow3
Rabbit3
Deer3
Crab3
Goat3
Ducks3
TxtFile2Sheet3.txt
Vegetables3
Eggs3
Meat3
Poultry3
Fish3
Seeds3
TxtFile3Sheet3.txt
Fiction3
Narrative3
Novel3
Thriller3
Mystery3
Poetry3
這是我想用來將這些 txt 檔案匯入到它們自己的列中的 VBA 作業區。
Sub ImportThreeTxtFiles()
'
' ImportThreeTxtFiles Macro
' Import three txt files into three columns per sheet
'
'
Application.CutCopyMode = False
With ActiveSheet.QueryTables.Add(Connection:= _
"TEXT;/Users/MyName/Documents/TxtFile1Sheet1", _
Destination:=Range("$A$2"))
.Name = "TxtFile1Sheet1"
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.RefreshPeriod = False
.TextFilePromptOnRefresh = False
.TextFilePlatform = 10000
.TextFileStartRow = 1
.TextFileParseType = xlDelimited
.TextFileTextQualifier = xlTextQualifierDoubleQuote
.TextFileConsecutiveDelimiter = False
.TextFileTabDelimiter = True
.TextFileSemicolonDelimiter = False
.TextFileCommaDelimiter = False
.TextFileSpaceDelimiter = False
.TextFileColumnDataTypes = Array(1)
.TextFileTrailingMinusNumbers = True
.Refresh BackgroundQuery:=False
End With
Range("B2").Select
Application.CutCopyMode = False
With ActiveSheet.QueryTables.Add(Connection:= _
"TEXT;/Users/MyName/Documents/TxtFile2Sheet1", _
Destination:=Range("$B$2"))
.Name = "TxtFile2Sheet1"
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.RefreshPeriod = False
.TextFilePromptOnRefresh = False
.TextFilePlatform = 10000
.TextFileStartRow = 1
.TextFileParseType = xlDelimited
.TextFileTextQualifier = xlTextQualifierDoubleQuote
.TextFileConsecutiveDelimiter = False
.TextFileTabDelimiter = True
.TextFileSemicolonDelimiter = False
.TextFileCommaDelimiter = False
.TextFileSpaceDelimiter = False
.TextFileColumnDataTypes = Array(1)
.TextFileTrailingMinusNumbers = True
.Refresh BackgroundQuery:=False
End With
Range("C2").Select
Application.CutCopyMode = False
With ActiveSheet.QueryTables.Add(Connection:= _
"TEXT;/Users/MyName/Documents/TxtFile3Sheet1", _
Destination:=Range("$C$2"))
.Name = "TxtFile3Sheet1"
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.RefreshPeriod = False
.TextFilePromptOnRefresh = False
.TextFilePlatform = 10000
.TextFileStartRow = 1
.TextFileParseType = xlDelimited
.TextFileTextQualifier = xlTextQualifierDoubleQuote
.TextFileConsecutiveDelimiter = False
.TextFileTabDelimiter = True
.TextFileSemicolonDelimiter = False
.TextFileCommaDelimiter = False
.TextFileSpaceDelimiter = False
.TextFileColumnDataTypes = Array(1)
.TextFileTrailingMinusNumbers = True
.Refresh BackgroundQuery:=False
End With
End Sub
Using this Macro I recorded, I want to import these files into their own sheets. How could I specify the three sets of files I will paste in a form of a loop? As in:
FileSet1 = TxtFile1Sheet1.txt, TxtFile2Sheet1.txt, TxtFile3Sheet1.txt
FileSet2 = TxtFile1Sheet2.txt, TxtFile2Sheet2.txt, TxtFile3Sheet2.txt
FileSet3 = TxtFile1Sheet3.txt, TxtFile2Sheet3.txt, TxtFile3Sheet3.txt
These columns will be named Animals, Type of Foods, Genres
Here is the desired output:
I am very new to VBA, I have more of a background in Python. This example is meant to be more conceptual. How would I be able to loop or call these files into these three columns? I'd love to see how the community tackles this to learn from it. I am currently watching videos and reading more about it. Thanks!
uj5u.com熱心網友回復：
請測驗下一個代碼并發送一些反饋。注意使用文本檔案所在的真實檔案夾路徑：
Sub ImportTextFilesInColumns()
Dim wb As Workbook, sh As Worksheet, strFoldPath As String
Dim fileName As String, shName As String, colNo As Long, arrHd, arrTxt
Set wb = ActiveWorkbook ' you can set here the workbook you need
arrHd = Split("Animals, Type of Foods, Genres", ", ") 'put the headers string in an array
strFoldPath = "Your real folder path" 'place here the folder path where the text file exist
'some optimization: _________________________________________________
Application.ScreenUpdating = False: Application.EnableEvents = False
Application.Calculation = xlCalculationManual
'____________________________________________________________________
'Place the header on the necessary sheets:
For Each sh In wb.Sheets
Select Case sh.Name
Case "Sheet1", "Sheet2", "Sheet3"
sh.Range("A1:C1").value = arrHd
End Select
Next
'iterate between all text files in strFolder:
fileName = dir(strFoldPath & "\*.txt")
Do While fileName <> ""
colNo = CLng(Mid(fileName, 8, 1)) 'extract column number
shName = Mid(fileName, 9, 6) 'extract sheet name
'place the content of the text file in an array:
arrTxt = Split(CreateObject("Scripting.FileSystemObject").OpenTextFile(strFoldPath & "\" & fileName, 1).ReadAll, vbCrLf)
wb.Sheets(shName).cells(2, colNo).Resize(UBound(arrTxt) 1, 1) = Application.Transpose(arrTxt) ' drop the array content
fileName = dir() 'continue the iteration between files
Loop
Application.ScreenUpdating = True: Application.EnableEvents = True
Application.Calculation = xlCalculationAutomatic
MsgBox "Ready..."
End Sub
如果沒有從文本檔案的最后 6 位數字中提取名稱的作業表（.txt 之前），則沒有錯誤處理。建立txt檔案名時一定要注意。這樣的錯誤處理可想而知，但上面代碼中沒有處理...
轉載請註明出處，本文鏈接：https://www.uj5u.com/yidong/387212.html
上一篇：檢查插入的ID是否已經存在