台灣最大程式設計社群網站
線上人數
909
 
會員總數:240668
討論主題:186529
歡迎您免費加入會員
討論區列表 >> office VBA / WinOS >> 一鍵TXT檔匯入至指定的Excel Sheet
[ 變換順序 ]  
[我要回覆]
回應主題 加入我的關注話題 檢舉此篇討論 將提問者加入個人黑名單
一鍵TXT檔匯入至指定的Excel Sheet
價值 : 20 QP  點閱數:218 回應數:0

樓主

morgan
門外漢
0 1
8 0
發送站內信


請各位指點 以下是我之前錄製的VBA,按一次按鈕只能匯入一個TXT檔 ,該如何修改才能讓我按一次鍵匯入我所要的所有TXT檔至指定的SHEET中 謝謝

Private Sub CommandButton1_Click()
Dim strFilt As String
Dim strTitle As String
Dim strFname As Variant
Dim i As Integer
Dim strMsg As String

strFilt = "文字檔案,*.txt,"
strTitle = "打開Excel文件"
strFname = Application.GetOpenFilename(FileFilter:=strFilt, Title:=strTitle, MultiSelect:=True)
If Not IsArray(strFname) Then
MsgBox "沒選擇文件!"
Else
For i = LBound(strFname) To UBound(strFname)
strMsg = strMsg & strFname(i) & vbCrLf
With ActiveSheet.QueryTables.Add(Connection:="TEXT;" & strFname(i), Destination:=Range("$A$5"))
.Name = "C"
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.TextFilePromptOnRefresh = False
.TextFilePlatform = 65001
.TextFileStartRow = 1
.TextFileParseType = xlDelimited
.TextFileTextQualifier = xlTextQualifierDoubleQuote
.TextFileConsecutiveDelimiter = True
.TextFileTabDelimiter = True
.TextFileSemicolonDelimiter = True
.TextFileCommaDelimiter = True
.TextFileSpaceDelimiter = True
.TextFileOtherDelimiter = "\"
.TextFileColumnDataTypes = Array(1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1)
.TextFileTrailingMinusNumbers = True
.Refresh BackgroundQuery:=False
End With
ActiveWindow.SmallScroll Down:=33
Cells.Select
Selection.RowHeight = 10
Selection.ColumnWidth = 5
Rows("19:50").Select
Selection.RowHeight = 0
Rows("76:134").Select
Selection.RowHeight = 0
ActiveWindow.SmallScroll Down:=-69
Columns("P:AS").Select
Selection.ColumnWidth = 0
ActiveWindow.ScrollColumn = 16
ActiveWindow.ScrollColumn = 15
ActiveWindow.ScrollColumn = 9
ActiveWindow.ScrollColumn = 3
ActiveWindow.ScrollColumn = 1
Range("K5").Select
Selection.TextToColumns Destination:=Range("K5"), DataType:=xlFixedWidth, _
FieldInfo:=Array(Array(0, 2), Array(9, 2), Array(11, 2)), TrailingMinusNumbers:= _
True

Next
MsgBox "選擇的文件是:" & vbCrLf & strMsg
End If

End Sub


我的TXT檔每次都會有 ICV.TXT CCV.TXT BK.TXT 20170627-C.TXT 20170627-CD.TXT EXCEL 的SHEET 名稱為 ICV CCV BK C CD
如何一次匯入這些TXT檔到各個指定的SHEET中 謝謝

搜尋相關Tags的文章: [ 匯入TXT檔 ] ,
本篇文章發表於2017-06-27 11:01
別忘捐VP感謝幫助你的人 新手會員瞧一瞧
目前尚無任何回覆
[ 變換順序 ]   

回覆
如要回應,請先登入.