[發問] 如何將TEXT轉成自訂的EXCEL檔

帖子: 5923
主題: 13
精華: 1
積分: 5986
點名: 0
作業系統: win10
軟體版本: Office 2010
閱讀權限: 150
性別: 男
來自: 台灣基隆
註冊時間: 2010-5-1
最後登錄: 2022-1-23

2017 雞年全勤獎章 2016猴年全勤獎章 2015羊年全勤獎章 2014馬年全勤獎章 2013蛇年全勤獎章 2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章 2011兔年全勤獎章

2^#

發表於 2010-6-15 16:34 | 只看該作者

回復 1# wsx24680

wsx24680

中學生 Rank: 2

帖子: 17
主題: 4
精華: 0
積分: 51
點名: 0
作業系統: win7
軟體版本: office2007
閱讀權限: 20
註冊時間: 2010-5-20
最後登錄: 2014-7-9

3^#

發表於 2010-6-15 18:35 | 只看該作者

回復 2# GBKEE

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

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

帖子: 5923
主題: 13
精華: 1
積分: 5986
點名: 0
作業系統: win10
軟體版本: Office 2010
閱讀權限: 150
性別: 男
來自: 台灣基隆
註冊時間: 2010-5-1
最後登錄: 2022-1-23

2017 雞年全勤獎章 2016猴年全勤獎章 2015羊年全勤獎章 2014馬年全勤獎章 2013蛇年全勤獎章 2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章 2011兔年全勤獎章

4^#

發表於 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

小學生 Rank: 1

帖子: 11
主題: 1
精華: 0
積分: 17
點名: 0
作業系統: WIN XP
軟體版本: office 2007
閱讀權限: 10
性別: 女
來自: 高雄
註冊時間: 2010-6-13
最後登錄: 2011-2-8

論壇贊助勳章

5^#

發表於 2010-6-16 07:09 | 只看該作者

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

帖子: 5923
主題: 13
精華: 1
積分: 5986
點名: 0
作業系統: win10
軟體版本: Office 2010
閱讀權限: 150
性別: 男
來自: 台灣基隆
註冊時間: 2010-5-1
最後登錄: 2022-1-23

2017 雞年全勤獎章 2016猴年全勤獎章 2015羊年全勤獎章 2014馬年全勤獎章 2013蛇年全勤獎章 2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章 2011兔年全勤獎章

6^#

發表於 2010-6-16 07:17 | 只看該作者

回復 5# q88007

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

wsx24680

中學生 Rank: 2

帖子: 17
主題: 4
精華: 0
積分: 51
點名: 0
作業系統: win7
軟體版本: office2007
閱讀權限: 20
註冊時間: 2010-5-20
最後登錄: 2014-7-9

7^#

發表於 2010-6-17 14:41 | 只看該作者

回復 4# GBKEE

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

資料夾.zip (290 Bytes)

還有幾點想請教一下，
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

帖子: 4901
主題: 44
精華: 24
積分: 4916
點名: 246
作業系統: Windows 7
軟體版本: Office 20xx
閱讀權限: 150
性別: 男
來自: 台北
註冊時間: 2010-4-30
最後登錄: 2024-11-12

2023年全勤獎章 2022虎年全勤獎章 2021牛年全勤獎章 2020鼠年全勤獎章 2019 豬年全勤獎章 2018 狗年全勤獎章 2017 雞年全勤獎章 2016猴年全勤獎章 2015羊年全勤獎章 2014馬年全勤獎章 2013蛇年全勤獎章 2012龍年全勤獎章論壇貢獻勳章熱心公益勳章 2011兔年全勤獎章

8^#

發表於 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

複製代碼

學海無涯_不恥下問

帖子: 5923
主題: 13
精華: 1
積分: 5986
點名: 0
作業系統: win10
軟體版本: Office 2010
閱讀權限: 150
性別: 男
來自: 台灣基隆
註冊時間: 2010-5-1
最後登錄: 2022-1-23

2017 雞年全勤獎章 2016猴年全勤獎章 2015羊年全勤獎章 2014馬年全勤獎章 2013蛇年全勤獎章 2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章 2011兔年全勤獎章

9^#

發表於 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

中學生 Rank: 2

帖子: 17
主題: 4
精華: 0
積分: 51
點名: 0
作業系統: win7
軟體版本: office2007
閱讀權限: 20
註冊時間: 2010-5-20
最後登錄: 2014-7-9

10^#

發表於 2010-6-18 09:48 | 只看該作者

回復 9# GBKEE

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