12
返回列表 上一主題 發帖

Excel 2010 轉置txt檔求助

Hsieh

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

2023年全勤獎章2022虎年全勤獎章2021牛年全勤獎章2020鼠年全勤獎章2019 豬年全勤獎章2018 狗年全勤獎章2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱心公益勳章2011兔年全勤獎章
8# 跳轉到 »
發表於 2013-7-3 10:06 | 只看該作者
回復 7# kulisung
  1. Sub ex()
  2. Set d = CreateObject("Scripting.Dictionary")
  3. Set d1 = CreateObject("Scripting.Dictionary")
  4. Set d2 = CreateObject("Scripting.Dictionary")
  5. fs = ThisWorkbook.Path & "\test.log" '文字檔目錄
  6. Open fs For Input As #1
  7. Do While Not EOF(1)
  8.    Line Input #1, mystr
  9.    If InStr(mystr, "- ") > 0 Then  
  10.    ElseIf InStr(mystr, "Time:") > 0 Then
  11.    no = Trim(Replace(mystr, "Time:", ""))
  12.    d(no) = ""
  13.    ElseIf InStr(mystr, ":") > 0 Then
  14.    n = Split(mystr, ":")(0)
  15.      d2(n) = ""
  16.      d1(no & Chr(10) & n) = IIf(d1(no & Chr(10) & n) = "", Trim(Replace(mystr, n & ":", "")), d1(no & Chr(10) & n) & Chr(10) & Trim(Replace(mystr, n & ":", "")))
  17.    Else
  18.      d1(no & Chr(10) & n) = d1(no & Chr(10) & n) & Chr(10) & mystr
  19.    End If
  20. Loop
  21. Close #1
  22. [A1] = "Time"
  23. [B1].Resize(, d2.Count) = d2.keys
  24. r = 1
  25. For Each ky In d.keys
  26. r = r + 1
  27. Cells(r, 1) = ky
  28.    For k = 1 To d2.Count
  29.       Cells(r, k + 1) = d1(ky & Chr(10) & Cells(1, k + 1))
  30.    Next
  31. Next
  32. End Sub
複製代碼
學海無涯_不恥下問

TOP

kulisung

帖子
9 
主題
1 
精華
0 
積分
15 
點名
0  
作業系統
Windows 7 
軟體版本
旗艦版 
閱讀權限
10 
註冊時間
2013-6-27 
最後登錄
2013-7-4 
7#
發表於 2013-7-2 16:46 | 只看該作者
回復 6# Hsieh


不好意思，試過程式轉出來似乎會造成錯位以及後面部份資料遺失（依上面的3筆資料來測試）
結果如下圖，再次麻煩真是不好意思
前半部份

後半部份

TOP

Hsieh

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

2023年全勤獎章2022虎年全勤獎章2021牛年全勤獎章2020鼠年全勤獎章2019 豬年全勤獎章2018 狗年全勤獎章2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱心公益勳章2011兔年全勤獎章
6#
發表於 2013-7-2 15:01 | 只看該作者
回復 5# kulisung
  1. Sub ex()
  2. Set d = CreateObject("Scripting.Dictionary")
  3. Set d1 = CreateObject("Scripting.Dictionary")
  4. Set d2 = CreateObject("Scripting.Dictionary")

  6. fs = ThisWorkbook.Path & "\test.log" '文字檔目錄
  7. Open fs For Input As #1
  8. Do While Not EOF(1)
  9.    Line Input #1, mystr
  10.    If InStr(mystr, "Time:") > 0 Then
  11.    no = Trim(Replace(mystr, "Time:", ""))
  12.    d(no) = ""
  13.    ElseIf InStr(mystr, ":") > 0 Then
  14.    n = Split(mystr, ":")(0)
  15.      d2(n) = ""
  16.      d1(no & Chr(10) & n) = Trim(Replace(mystr, n & ":", ""))
  17.      Else
  18.      d1(no & Chr(10) & n) = d1(no & Chr(10) & n) & Chr(10) & mystr
  19.    End If
  20. Loop
  21. Close #1
  22. [A1] = "Time"
  23. [B1].Resize(, d2.Count) = d2.keys
  24. r = 1
  25. For Each ky In d.keys
  26. r = r + 1
  27. Cells(r, 1) = ky
  28.    For k = 1 To d2.Count
  29.       Cells(r, k + 1) = d1(ky & Chr(10) & Cells(1, k))
  30.    Next
  31. Next
  32. End Sub
複製代碼
學海無涯_不恥下問

TOP

kulisung

帖子
9 
主題
1 
精華
0 
積分
15 
點名
0  
作業系統
Windows 7 
軟體版本
旗艦版 
閱讀權限
10 
註冊時間
2013-6-27 
最後登錄
2013-7-4 
5#
發表於 2013-7-2 00:13 | 只看該作者
回復 4# Hsieh

感謝超級版主 Hsieh 的回覆
不過大概是因為我只是擷取一段log內容的關係，因為發現轉出的內容似乎有錯
經過查看似乎是因為是用"-"來區分，所以造成這樣的錯誤
因為看過大量的log內容發現不同的日期會有相同的-----xx----- 紀錄
例如
  -------------- 01 --------------
Time: 2013.06.25, 00:01:10
.
-------------- 01 --------------
Time: 2013.06.26, 10:01:20      
.
.
看起來時間才算是唯一值


以下是實際的log內容
-------------- 19 --------------
Time: 2013.06.25, 00:44:13
Connect : OK!
   Model: C1200
   Version: 1.0.0-9
   Mac: 00:FF:AA:BB:CC:01
Video :
   Jpeg Connection...Ok
   Image Check : Ok
Audio In :
   Connection...Ok
   PC Listening Check : Ok
Wlan :
   Enable Wlan...Ok
   Set ESSID...Ok
   Try connect Camera...Ok
CountryCode :
   Write Code...Ok!
LightSensor :
   Test Sensor...Ok
Reset Button :
   Setting Test mode...Ok!
   Test Button...Ok
WPS Button :
   Setting Test mode...Ok!
   Test Button...Ok
Link QRCode :
   Input : 11100000001A0123456
   Write Mac...Ok
   Check Mac...Ok! New Mac: 00:FF:AA:BB:CC:0F
Cloud Version :
   Getting...Version: 1.1
Fast Factory Reset :
   Reset Camera...Ok!
   Model: C1200
   Version: 1.0.0-9
   Mac: 00:FF:AA:BB:CC:0F
   Country Code: 0
-------------- 20 --------------
Time: 2013.06.25, 00:46:26
Connect : OK!
   Model: C1200
   Version: 1.0.0-9
   Mac: 00:FF:AA:BB:CC:02
Video :
   Jpeg Connection...Ok
   Image Check : Ok
Audio In :
   Connection...Ok
   PC Listening Check : User Stop!
-------------- 19 --------------
Time: 2013.06.25, 06:07:22
Connect : OK!
   Model: C1200
   Version: 1.0.0-9
   Mac: 00:FF:AA:BB:CC:03
Video :
   Jpeg Connection...Ok
   Image Check : Ok
Audio In :
   Connection...Ok
   PC Listening Check : Ok
Wlan :
   Enable Wlan...Ok
   Set ESSID...Ok
   Try connect Camera...Ok
CountryCode :
   Write Code...Ok!
LightSensor :
   Test Sensor...Ok
Reset Button :
   Setting Test mode...Ok!
   Test Button...Ok
WPS Button :
   Setting Test mode...Ok!
   Test Button...Ok
Link QRCode :
   Input : 11100000001A923415
   Write Mac...Ok
   Check Mac...Ok! New Mac: 00:FF:AA:BB:CC:1A
Cloud Version :
   Getting...Version: 1.1
Fast Factory Reset :
   Reset Camera...Ok!
   Model: C1200
   Version: 1.0.0-9
   Mac: 00:FF:AA:BB:CC:1A
   Country Code: 0

這樣的判斷條件是否又複雜了些呢？ 還請超級版主協助 感恩

TOP

Hsieh

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

2023年全勤獎章2022虎年全勤獎章2021牛年全勤獎章2020鼠年全勤獎章2019 豬年全勤獎章2018 狗年全勤獎章2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱心公益勳章2011兔年全勤獎章
4#
發表於 2013-7-1 16:36 | 只看該作者
回復 3# kulisung
  1. Sub ex()
  2. Set d = CreateObject("Scripting.Dictionary")
  3. Set d1 = CreateObject("Scripting.Dictionary")
  4. Set d2 = CreateObject("Scripting.Dictionary")

  6. fs = ThisWorkbook.Path & "\test.log" '文字檔目錄
  7. Open fs For Input As #1
  8. Do While Not EOF(1)
  9.    Line Input #1, mystr
  10.    If InStr(mystr, "-- ") > 0 Then
  11.    no = Trim(Replace(mystr, "-", ""))
  12.    d(no) = ""
  13.    ElseIf InStr(mystr, ":") > 0 Then
  14.    n = Split(mystr, ":")(0)
  15.      d2(n) = ""
  16.      d1(no & Chr(10) & n) = Trim(Replace(mystr, n & ":", ""))
  17.      Else
  18.      d1(no & Chr(10) & n) = d1(no & Chr(10) & n) & Chr(10) & mystr
  19.    End If
  20. Loop
  21. Close #1
  22. [A1].Resize(, d2.Count) = d2.keys
  23. r = 1
  24. For Each ky In d.keys
  25. r = r + 1
  26.    For k = 1 To d2.Count
  27.       Cells(r, k) = d1(ky & Chr(10) & Cells(1, k))
  28.    Next
  29. Next
  30. End Sub
複製代碼
學海無涯_不恥下問

TOP

kulisung

帖子
9 
主題
1 
精華
0 
積分
15 
點名
0  
作業系統
Windows 7 
軟體版本
旗艦版 
閱讀權限
10 
註冊時間
2013-6-27 
最後登錄
2013-7-4 
3#
發表於 2013-7-1 13:30 | 只看該作者
回復 2# luhpro


    Hi~luhpro大大∼感謝你的回覆
因為小弟並不是很懂VBA的語法，只是邏輯概念還可以
至於那d(lpos)的用法，小弟有稍微咕狗一下Dictionary的涵義
但仍是不甚瞭解（因小弟無coding的經驗，所以一些深入的概念要瞭解有點小難）
試過大大的程式也是在d(lpos)這行出現問題沒有定義的問題
請問d(lpos)是否需要另外定義？

TOP

luhpro

帖子
835 
主題
6 
精華
0 
積分
915 
點名
16  
作業系統
Win 10,7 
軟體版本
2019,2013,2003 
閱讀權限
50 
性別
男 
註冊時間
2010-5-3 
最後登錄
2024-11-14 
2#
發表於 2013-6-30 22:27 | 只看該作者
本帖最後由 luhpro 於 2013-6-30 22:28 編輯

回復 1# kulisung
關於讀檔的程式這裡就不贅述了,
僅提供自己想的資料存放位置處理方式: (d(lpos) 是利用 Dictionary 來索引該資料存放的欄位)

讀檔...
lrow = 2 ' 列 1 為標題列
icol = 1 ' 資料從第 1 欄開始放, 假設每筆資料 Title 文字都相同
sStr = 讀取的一筆資料內容

Do While EOF(1)
  Do While Left(sStr, 5) <> "-----"
   lpos = InStr(1, sStr, ":")
    stitle = Trim(Left(sStr, lpos - 2))
    If d(lpos) = "" Then
      Cells(1, icol) = stitle
      icol = icol + 1
    End If
    sData = Trim(Mid(sStr, lpos + 2, Len(sStr) - lpos))
    sStr = 讀取的一筆資料內容
  Loop
  lrow = lrow + 1
Loop

' 關檔

TOP

        靜思自在 : 【時間如鑽石】時間對一個有智慧的人而言，就如鑽石般珍貴；但對愚人來說，卻像是一把泥土，一點價值也沒有。
12
返回列表 上一主題