麻辣家族討論版版's Archiver

wsx24680 發表於 2010-6-15 16:06

如何將TEXT轉成自訂的EXCEL檔

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

[attach]1286[/attach]

還請各位前輩指教。

GBKEE 發表於 2010-6-15 16:34

[b]回復 [url=http://forum.twbts.com/redirect.php?goto=findpost&pid=2210&ptid=586]1#[/url] [i]wsx24680[/i] [/b]
[attach]1287[/attach]

wsx24680 發表於 2010-6-15 18:35

[b]回復 [url=http://forum.twbts.com/redirect.php?goto=findpost&pid=2211&ptid=586]2#[/url] [i]GBKEE[/i] [/b]


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

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

GBKEE 發表於 2010-6-15 21:04

[b]回復 [url=http://forum.twbts.com/redirect.php?goto=findpost&pid=2215&ptid=586]3#[/url] [i]wsx24680[/i] [/b][code]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
[/code]

q88007 發表於 2010-6-16 07:09

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

GBKEE 發表於 2010-6-16 07:17

[b]回復 [url=http://forum.twbts.com/redirect.php?goto=findpost&pid=2241&ptid=586]5#[/url] [i]q88007[/i] [/b]


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

wsx24680 發表於 2010-6-17 14:41

[b]回復 [url=http://forum.twbts.com/redirect.php?goto=findpost&pid=2220&ptid=586]4#[/url] [i]GBKEE[/i] [/b]

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

[i=s] 本帖最後由 Hsieh 於 2010-6-18 08:26 編輯 [/i]

[b]回復 [url=http://forum.twbts.com/redirect.php?goto=findpost&pid=2293&ptid=586]7#[/url] [i]wsx24680[/i] [/b][code]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
[/code]

GBKEE 發表於 2010-6-18 07:04

[i=s] 本帖最後由 GBKEE 於 2010-6-18 07:22 編輯 [/i]

[b]回復 [url=http://forum.twbts.com/redirect.php?goto=findpost&pid=2299&ptid=586]8#[/url] [i]Hsieh[/i] [/b]
Hsieh 板主 你宣告fs$ 為字串型態  
If fs = [color=Red]False[/color] Then MsgBox "請選擇文字檔": Exit  Sub  
會產生 [型態不符] 的錯誤 修正如程式碼[code]Dim Ar(), Mystr$, a$, s&, k%, fs$
Cells = ""
fs = Application.GetOpenFilename("Text Files (*.txt), *.txt")
If fs = "False" Then MsgBox "請選擇文字檔": Exit Sub[/code][b]回復 [url=http://forum.twbts.com/redirect.php?goto=findpost&pid=2293&ptid=586]7#[/url] [i]wsx24680[/i] [/b]
請參考另一個開啟檔案的寫法[code]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
[/code]

wsx24680 發表於 2010-6-18 09:48

[b]回復 [url=http://forum.twbts.com/redirect.php?goto=findpost&pid=2324&ptid=586]9#[/url] [i]GBKEE[/i] [/b]


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

頁: [1]

麻辣家族討論版版為 麻辣學園 網站成員  由 昱得資訊工作室 © Since 1993 所提供