麻辣家族討論版版 - Powered by Discuz! Board

標題: [發問] 如何將TEXT轉成自訂的EXCEL檔 [打印本頁]

作者: wsx24680 時間: 2010-6-15 16:06 標題: 如何將TEXT轉成自訂的EXCEL檔

請問各位前輩：
如下列附件，如何將"文字文件.txt"轉成"文件.xls"中的樣式？

[attach]1286[/attach]

還請各位前輩指教。

作者: GBKEE 時間: 2010-6-15 16:34

回復 1# wsx24680
[attach]1287[/attach]

作者: wsx24680 時間: 2010-6-15 18:35

回復 2# GBKEE

GBKEE前輩：
不好意思…可能是我表達上有問題，我的意思是能夠變成像"文件.xls"中的排列方式，
並不只是單純的用excel來打開txt檔；而是打開txt檔後能夠將裡面的資料排列成"文件.xls"中的樣子，
所以附件中"文件.xls"是算是答案，是將txt檔轉換後的結果。

感謝GBKEE前輩指點，可惜跟我想要達成的結果不一樣。

作者: GBKEE 時間: 2010-6-15 21:04

回復 3# wsx24680

Sub Ex()
Dim MyString, C%, R%, Ar
C = 2: R = 1
Open "D:\TEST\文字文件.TXT" For Input As #1 ' 開啟輸入檔案。
Do While Not EOF(1) ' 執行迴圈直到檔尾為止。
Input #1, MyString ',將資料讀入MyNumber變數中。
If InStr(MyString, "=") Then
Ar = Split(MyString, Chr(9))
Cells(R, C) = Ar(0)
Cells(R, C + 1) = Split(Ar(1), "=")(0)
Cells(R, C + 2) = "="
Cells(R, C + 3) = Split(Ar(1), "=")(1)
R = R + 1
If R >= 20 Then R = 1: C = C + 6
End If
Loop
Close #1 ' 關閉檔案。
End Sub

複製代碼

作者: q88007 時間: 2010-6-16 07:09

請問一下Cells(R, C) = Ar(0) 是什麼意思，因為我依GBKEE前輩所告知之巨集進行測試後，
出現階段執行錯誤'1004'，???

作者: GBKEE 時間: 2010-6-16 07:17

回復 5# q88007

程式碼有修改嗎? 如有請附上

作者: wsx24680 時間: 2010-6-17 14:41

回復 4# GBKEE

GBKEE版大：
十分抱歉，小弟剛剛才注意到附錯檔案了，對不起，
之前附上的是有修改過的內容，剛剛測試時才發現，
原始的TEXT中的內容如附件。
[attach]1309[/attach]

還有幾點想請教一下，
1.檔路徑可以用選的嗎？像開啟舊檔那樣…
2.If R >= 20 Then R = 1: C = C + 6，如果資料長度不一定，
但用------來判斷的話是改成
If InStr(MyString, "----") Then R = 1: C = C + 6，這樣嗎？

另外剛剛小弟有想試著修改程式，但不知為何抓不到"="跟後面的值，
第一次MyString抓到"3"後來"AAA-AA"、"11"、後來就變抓到"22"了跳過了"11"後面的"=10"
不知為何？還請版大解惑？

再次感謝版大的幫忙

作者: Hsieh 時間: 2010-6-17 20:03

本帖最後由 Hsieh 於 2010-6-18 08:26 編輯

回復 7# wsx24680

Sub Ex()
Dim Ar(), Mystr$, a$, s&, k%, fs$
Cells = ""
fs = Application.GetOpenFilename("Text Files (*.txt), *.txt")
If fs = "False" Then MsgBox "請選擇文字檔": Exit Sub
k = 2
Open fs For Input As #1
Do While Not EOF(1)
Line Input #1, Mystr
If Mystr <> "" And Not IsDate(Mystr) Then
If InStr(Mystr, "=") = 0 And InStr(Mystr, "---") = 0 Then
a = Mystr
ElseIf InStr(Mystr, "=") > 0 Then
ReDim Preserve Ar(s)
Ar(s) = Array(a, Split(Mystr, "=")(0), "=", Split(Mystr, "=")(1))
s = s + 1
ElseIf InStr(Mystr, "---") > 0 Then
Cells(1, k).Resize(s, 4).Value = Application.Transpose(Application.Transpose(Ar))
k = k + 6: s = 0: Erase Ar
End If
End If
Loop
If s > 0 Then Cells(1, k).Resize(s, 4).Value = Application.Transpose(Application.Transpose(Ar))
Close #1
End Sub

複製代碼

作者: GBKEE 時間: 2010-6-18 07:04

本帖最後由 GBKEE 於 2010-6-18 07:22 編輯

回復 8# Hsieh
Hsieh 板主你宣告fs$ 為字串型態
If fs = False Then MsgBox "請選擇文字檔": Exit Sub
會產生 [型態不符] 的錯誤修正如程式碼

Dim Ar(), Mystr$, a$, s&, k%, fs$
Cells = ""
fs = Application.GetOpenFilename("Text Files (*.txt), *.txt")
If fs = "False" Then MsgBox "請選擇文字檔": Exit Sub

複製代碼

回復 7# wsx24680
請參考另一個開啟檔案的寫法

Sub Ex()
Dim Ar(), Mystr$, a$, s&, k%, fs$
With Application.FileDialog(msoFileDialogOpen)
.Title = "尋找文字檔"
.AllowMultiSelect = False '只準許選取一個檔案
.ButtonName = "開啟Txt檔"
.InitialFileName = "d:\test\*.txt" '設定檔案所在的資料夾及副檔名
If .Show = False Then
MsgBox "請選擇文字檔": Exit Sub
Else
fs = .SelectedItems(1)
End If
End With
k = 2
Open fs For Input As #1
Do While Not EOF(1)
'
'
Loop
If s > 0 Then Cells(1, k).Resize(s, 4).Value = Application.Transpose(Application.Transpose(Ar))
Close #1
End Sub

複製代碼

作者: wsx24680 時間: 2010-6-18 09:48

回復 9# GBKEE

感謝GBKEE版大及Hsieh版大的幫忙，
目前程式執行沒有問題，結果也正確。
內容我還要研究一下，
若有發現其它問題，再來向各位請教。

歡迎光臨麻辣家族討論版版 (http://forum.twbts.com/)