- 帖子
- 5
- 主題
- 2
- 精華
- 0
- 積分
- 12
- 點名
- 0
- 作業系統
- win
- 軟體版本
- xp
- 閱讀權限
- 10
- 性別
- 男
- 註冊時間
- 2013-6-25
- 最後登錄
- 2020-5-19
|
stillfish00您好, 若資料改程如下:
1.txt
營業人統一編號 11111111
負責人姓名 許xx
營業人名稱 xx企業社
營業（稅籍）登記地址 xx市xx區xx里xx路xx巷xx號x樓
資本額(元) 100000
組織種類 獨資( 6 )
設立日期 1020723
登記營業項目 普通倉儲經營( 530100 )
船上貨物裝卸( 525912 )
包裝承攬服務( 820914 )
2.txt
營業人統一編號 01111111
負責人姓名 黃xx
營業人名稱 xx企業社
營業（稅籍）登記地址 xx市xx區xx里xx路xx巷xx－x號x樓
資本額(元) 60000
組織種類 獨資( 6 )
設立日期 0780522
登記營業項目 其他金屬模具製造( 251299 )
.
.
.
根據您的程式修改如下:
Sub importtxt()
Dim path, folder, fname
With Workbooks.Add '標題列
.Sheets(1).Range("A1:H1") = Array("營業人統一編號", "負責人姓名", "營業人名稱", "營業（稅籍）登記地址", "資本額(元)", "組織種類", "設立日期", "登記營業項目")
'新增暫存資料表
With .Sheets.Add(after:=.Sheets(.Sheets.Count))
'瀏覽選擇資料夾
With Application.FileDialog(msoFileDialogFolderPicker)
.AllowMultiSelect = False
If .Show = -1 Then path = .SelectedItems(1) & "\"
End With
'對所有該資料夾下的txt處理
folder = Dir(path & "*.txt")
Do While folder <> ""
.Cells.ClearContents
'匯入外部資料
With .QueryTables.Add(Connection:="TEXT;" & path & folder, Destination:=.Range("A1"))
.Name = "資料"
.RefreshPeriod = 0
.TextFileSpaceDelimiter = True '空白鍵為分割字元
.Refresh BackgroundQuery:=False
End With
'刪除資料連線
.Cells.QueryTable.Delete
'新增資料到第一個工作表
.Parent.Sheets(1).Cells(.Rows.Count, "A").End(xlUp).Offset(1).Resize(, 8).Value = Application.Transpose(.Range("B1:B8").Value)
folder = Dir
Loop
'刪除暫存資料表,不顯示警告視窗
Application.DisplayAlerts = False
.Delete
Application.DisplayAlerts = True
End With
.Sheets(1).Activate '使開啟該檔時直接到第一個工作表
'存檔
fname = Application.GetSaveAsFilename(InitialFileName:=path & "final.xls", FileFilter:="Excel Files (*.xls),*.xls", Title:="儲存檔案")
'除非按取消, 否則存檔
If TypeName(fname) = "String" Then .SaveAs Filename:=fname, FileFormat:=xlExcel8
End With
End Sub
但是會有3個問題,
1. 若"營業人統一編號"第一碼是0, 讀入後第一碼0會不見.
2. "組織種類"的資料,例如是: 獨資( 6 ), 因為(和6中間是空白, 資料會只讀到"獨資("就停止.
3. "登記營業項目",也有像第二項一樣的問題,(後是空白,後面的資料就會不見.
想請問如何解決這三個問題? 太感謝您的幫忙了~ |
|
發表於 2013-6-25 03:16
| 
