Board logo

標題: Excel 2010 轉置txt檔求助 [打印本頁]
作者: kulisung    時間: 2013-6-27 18:14     標題: Excel 2010 轉置txt檔求助

各位大大安，最近臨時受命協助一個系統log檔案轉換，但由於小弟並不熟悉VBA，也查過許多函數用法但仍無法解決問題，所以想向大家請教
問題如下:
log的txt檔內容大致如下
-------------- 01 --------------
Time: 2013.06.25, 00:01:10
Connect : OK!
   Model: C200
   Version: 1.0.0-1
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
SN:
   Input : AA0001
-------------- 02 --------------
Time: 2013.06.25, 00:01:20
Connect : OK!
   Model: C200
   Version: 1.0.0-9
Video :
   Jpeg Connection...Ok
   Image Check : User Stop!
-------------- 03 --------------
Time: 2013.06.25, 00:01:30
Connect : OK!
   Model: C200
   Version: 1.0.0-9
Video :
   Jpeg Connection...Ok
   Image Check : Ok
Audio In :
   Connection...Ok
   PC Listening Check : User Stop!
原想直接轉置，但發現此log檔案轉出的欄位並非每一筆都是完整的，由內容可以看出---01---算是一筆完整的紀錄，02和03則並沒有包含完整的欄位紀錄
而在無法變動log輸出格式的情況下，為了方便統計分析，需要將此紀錄轉為橫式，但因欄位紀錄資料無法直接轉置
想請教各位大大可以透過有甚麼方式轉置這樣的資料呢?
麻煩了~~感謝!
作者: luhpro    時間: 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

' 關檔
作者: kulisung    時間: 2013-7-1 13:30

回復 2# luhpro


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

這樣的判斷條件是否又複雜了些呢？ 還請超級版主協助 感恩
作者: Hsieh    時間: 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
複製代碼
作者: kulisung    時間: 2013-7-2 16:46

回復 6# Hsieh


不好意思，試過程式轉出來似乎會造成錯位以及後面部份資料遺失（依上面的3筆資料來測試）
結果如下圖，再次麻煩真是不好意思
前半部份
[attach]15348[/attach]
後半部份
[attach]15349[/attach]
作者: Hsieh    時間: 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
複製代碼
作者: kulisung    時間: 2013-7-3 10:31

回復 8# Hsieh


感謝Hsieh版主大大幫忙，這邊還有個小問題
就是似乎因為有部份欄位是相同的，所以會將資料內容擺放在一起
請問有辦法將他視為不同而分開嗎？就如log內容原本的順序
很不好意思因為小弟不是很懂，感謝幫忙
如下圖（Model，MAC，Version）
[attach]15355[/attach]
作者: Hsieh    時間: 2013-7-3 16:46

回復 9# kulisung
調整欄寬就可以看出資料是同一儲存格分列存放
作者: kulisung    時間: 2013-7-3 17:47

回復 10# Hsieh


    感謝回覆，小弟知道拉寬資料都會顯示出來
    那若要將該列的值分為分欄排放（非分列）
    程式是否會因為少了判斷值而無法達成？
    因為欄位名稱都一樣，所以造成位置的指定都相同
    （小弟這樣的想法可對？)
作者: GBKEE    時間: 2013-7-3 18:56

回復 11# kulisung
為何不上傳,文字檔,轉置後的excel範例檔,可以一目了然你的問題.
作者: kulisung    時間: 2013-7-3 22:25

回復 12# GBKEE

不好意思，文字檔就如前面所列3筆，原想擷取此3筆資料應該足夠（實際上千筆）
另外原本是想上傳excel結果，但是附件格式不允許？只好上傳圖片
而剛剛才發現可以上傳zip檔，真不好意思
不過就如前面的圖片所說的那樣
最後轉出結果因欄位名稱相同，所以會將資料內容皆放在同一儲存格
現在是希望能區隔開，只是依自己想法去判斷似乎是會很麻煩？
若造成困擾小弟在這說聲抱歉
[attach]15364[/attach]
作者: kulisung    時間: 2013-7-3 22:35

回復 13# kulisung


重新上傳一次壓縮檔
上面那個檔案沒有更新到部份說明
[attach]15365[/attach]
作者: GBKEE    時間: 2013-7-4 09:51

回復 14# kulisung
試試看
  1. Option Explicit
  2. Sub Ex()
  3.     Dim Txt As String, Fs As Object, d, A(), Tile As String, S As String, Stile As String, i, ii As Integer
  4.     Txt = "d:\logfile.log" '文字檔目錄
  5.     Set Fs = CreateObject("Scripting.FileSystemObject").OpenTextFile(Txt, 1)
  6.     'OpenTextFile 方法 開啟一個指定的檔案並傳回一個 TextStream 物件，該物件可用於對檔案進行讀取或附加。
  7.     d = Split(Fs.readall, Chr(10))
  8.     Fs.Close                                                                    '關閉文字檔
  9.     For i = 0 To UBound(d)
  10.         If InStr(d(i), "---") Then
  11.             If S <> "" Then
  12.                 If Len(Stile) > Len(Tile) Then Tile = Stile                     '確定欗位標頭
  13.                ReDim Preserve A(0 To ii)
  14.                A(ii) = S
  15.                ii = ii + 1
  16.             End If
  17.             Stile = ""                                                          '清除記錄欗位的標頭
  18.             S = ""                                                              '清除記錄
  19.         ElseIf InStr(d(i), ":") Then
  20.             Stile = Stile & IIf(Stile <> "", "##", "") & Split(d(i), ":")(0)    '記錄欗位的標頭
  21.             S = S & IIf(S <> "", "##", "") & Trim(Replace(d(i), Mid(d(i), 1, InStr(d(i), ":")), ""))
  22.         ElseIf InStr(d(i), ":") = 0 Then
  23.             S = S & IIf(InStr(d(i - 1), ":"), "", Chr(10)) & Trim(d(i))
  24.         End If
  25.     Next
  26.     ReDim Preserve A(0 To ii)
  27.     A(ii) = S                                                                    '最後一筆資料
  28.     If Len(Stile) > Len(Tile) Then Tile = Stile                                  '確定欗位標頭
  29.     With ActiveSheet
  30.         .Cells.Clear
  31.         .[A1].Resize(1, UBound(Split(Tile, "##")) + 1) = Split(Tile, "##")       '匯入欗位標頭
  32.         For Each i In A
  33.             .Cells(.Rows.Count, 1).End(xlUp).Offset(1).Resize(1, UBound(Split(i, "##")) + 1) = Split(i, "##")
  34.                                                                                   '匯入紀錄資料
  35.         Next
  36.         .Columns.EntireColumn.AutoFit                                             '調整欄寬
  37.     End With
  38. End Sub
複製代碼
作者: kulisung    時間: 2013-7-4 11:54

回復 15# GBKEE

感謝GBKEE回覆
測試過可以滿足需求的格式
感謝幫忙∼
作者: xiaoyuandlg    時間: 2014-7-11 11:16

I am quite interested in this topic though I am new to the using of VBA, this question also remind me of the qrcode excel



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