返回列表 上一主題 發帖

(已解決)麻煩幫忙

(已解決)麻煩幫忙

本帖最後由 softsadwind 於 2011-8-12 23:59 編輯

想把 units.rar (1.61 KB) 轉成 表格.rar (1.97 KB)
unit.txt內有5863個大陣列,或者更多。
格式如下
{s:11:"cat_persian";a:13:{s:10:"masterymax";s:2:"10";s:5:"sizeY";s:1:"1";s:5:"sizeX";s:1:"1";s:9:"coinYield";s:2:"90";s:7:"buyable";s:5:"false";s:4:"code";s:2:"oq";s:7:"iconurl";s:42:"assets/animals/animal_cat_persian_icon.png";s:4:"type";s:6:"animal";s:4:"name";s:11:"cat_persian";s:13:"requiredLevel";s:1:"1";s:4:"cost";s:5:"50000";s:8:"growTime";s:1:"3";s:6:"action";s:7:"harvest";}
s:11代表字數,不含"",a:13好像代表接下來的陣列有幾個,從mastermax 到action共13個

從unit.txt中取得資料列表,依序排列。可以選擇"type"並反譯成animal_info.txt,格式同一開始的格式。                                                                                                       
                 masterymax        sizeX        sizeY        coinYield        buyable        code        iconurl                                                          type        name        requiredLevel        cost        growTime        action
cat_persian                10                  1        1        90                 flase                  oq        assets/animals/animal_cat_persian_icon.png        animal        cat_persian        1                 50000        3        harvest
還請哪為大大協助,感謝。
50 字節以內
不支持自定義 Discuz! 代碼

回復 1# softsadwind
這樣寫入工作表後,先檢查看看對不對
  1. Sub Ex()
  2. Dim Mystr$, Ar()
  3. Set d = CreateObject("Scripting.Dictionary")
  4. fd = "C:\Documents and Settings\m\My Documents\"
  5. [B5:N5] = Array("masterymax", "sizeX", "sizeY", "coinYield", "buyable", "code", "iconurl", "type", "name", "requiredLevel", "cost", "growTime", "action")

  6. Open fd & "units.txt" For Input As #1
  7. Range("A6:N65536") = ""
  8. r = 6
  9. Do While Not EOF(1)
  10.   Input #1, Mystr
  11.   a = Split(Mystr, "}")
  12.   For i = 0 To UBound(a)
  13.       b = Split(a(i), """;")
  14.       For j = 0 To UBound(b)
  15.          ReDim Preserve Ar(s)
  16.          If b(j) <> "" And InStr(b(j), """") > 0 Then Ar(s) = Split(b(j), """")(1)
  17.          s = s + 1
  18.       Next
  19.       For j = 1 To UBound(Ar) - 1
  20.           d(Ar(j)) = Ar(j + 1)
  21.       Next
  22.       Cells(r, 1) = d("name")
  23.       For k = 2 To 14
  24.          Cells(r, k) = d(Cells(5, k).Text)
  25.       Next
  26.       r = r + 1: Erase Ar: s = 0: d.RemoveAll
  27.   Next
  28. Loop
  29. Close #1
  30. End Sub
複製代碼
學海無涯_不恥下問

TOP

謝謝板主,我想一下,再把我的方法 弄上來,
50 字節以內
不支持自定義 Discuz! 代碼

TOP

真是高手,我一看見提問者的Txt 資料..我就己經暈倒.
NeverTry , NeverNo !

TOP

第12行  a = Split(Mystr, "}")
改成     a = Split(Mystr, """}")
不然出現陣列索引超過範圍

這個檔案本身不規則性太多了...感謝板主幫忙...小弟還是放棄好了
不過學了不少東西...當成是一個優良範例:>
50 字節以內
不支持自定義 Discuz! 代碼

TOP

後來想想 還是po一下我的想法...看看有沒有大大有更好的想法
  1. Sub Ex()
  2. Dim Mystr$, Ar()
  3. Set d = CreateObject("Scripting.Dictionary")
  4. fd = "C:\"
  5. [B5:W5] = Array("masterymax", "sizeX", "sizeY", "cash", "coinYield", "buyable", "market", "subtype", "code", "iconurl", "type", "plantXp", "name", "requiredLevel", "cost", "growTime", "action", "license", "limitedEnd", "", "", "")

  6. Open fd & "units.txt" For Input As #1
  7. Range("A6:W65536") = ""
  8. r = 6
  9. Do While Not EOF(1)
  10.   Input #1, Mystr
  11.   a = Split(Mystr, ";}")
  12.   For i = 0 To UBound(a)
  13.       b = Split(a(i), ";")
  14.       
  15.       For j = 0 To UBound(b)
  16.          ReDim Preserve Ar(s)
  17.          If b(j) <> """" And InStr(b(j), """") > 0 Then Ar(s) = Split(b(j), """")(1)
  18.          s = s + 1
  19.       Next
  20.       For j = 1 To UBound(Ar) - 1
  21.           d(Ar(j)) = Ar(j + 1)
  22.       Next
  23.       Cells(r, 1) = d("name")
  24.       For k = 2 To 22
  25.          Cells(r, k) = d(Cells(5, k).Text)
  26.       Next
  27.       r = r + 1: Erase Ar: s = 0: d.RemoveAll
  28.   Next
  29. Loop
  30. Close #1
  31. End Sub
複製代碼
fd修改放在c: 因為每個人的帳號不一樣..
a = Split(Mystr, ";}") 修改多一個;,不然會出現超出範圍
code那一欄 有可能用 "," 或者 "0"當代碼,
後來發現 其實他的B5:W5的名稱不見得所有項目都會有..附上檔案
雖然說放棄了 不過這幾天還是持續在研究:P
表格.rar (289.51 KB) units.rar (107.36 KB)
50 字節以內
不支持自定義 Discuz! 代碼

TOP

回復 6# softsadwind
格式如下
{s:11:"cat_persian";a:13:{s:10:"masterymax";s:2:"10";s:5:"sizeY";s:1:"1";s:5:"sizeX";s:1:"1";s:9:"coinYield";s:2:"90";s:7:"buyable";s:5:"false";s:4:"code";s:2:"oq";s:7:"iconurl";s:42:"assets/animals/animal_cat_persian_icon.png";s:4:"type";s:6:"animal";s:4:"name";s:11:"cat_persian";s:13:"requiredLevel";s:1:"1";s:4:"cost";s:5:"50000";s:8:"growTime";s:1:"3";s:6:"action";s:7:"harvest";}

但其中有許多筆格式不符
  1. Sub Ex()
  2.     Dim FS As Object, d As Object, i%, ii%, Ar, Ar1, Ar2
  3.     Dim f
  4.     Set FS = CreateObject("Scripting.FileSystemObject").OpenTextFile(ThisWorkbook.Path & "\units.txt", 1, -2) 'TextStream 物件->加快對檔案的順序存取。
  5.     Ar = Split(Replace(FS.READALL, Chr(10), ""), "}")  '讀取資料存入陣列 Ar
  6.     FS.Close                             ' 將檔案關閉。
  7.     [a5:iv65536] = ""
  8.     On Error GoTo aa
  9.     r = 6
  10.     For i = 0 To UBound(Ar)
  11.         Set d = CreateObject("Scripting.Dictionary")
  12.         'If InStr(Ar(i), "{") Then
  13.             Ar1 = Split(Ar(i), "{")
  14.             If i = 0 Then
  15.                 d("Name") = Split(Ar1(1), """")(1)
  16.                 Ar2 = Split(Ar1(2), """")
  17.             Else
  18.                 d("Name") = Split(Ar1(0), """")(1)
  19.                 Ar2 = Split(Ar1(1), """")
  20.             End If
  21.             For ii = 1 To UBound(Ar2) - 4 Step 4
  22.                 d(Ar2(ii)) = Ar2(ii + 2)
  23.             Next
  24.             For Each key In d
  25.                 If key = "Name" Then
  26.                     Cells(r, 1) = d(key)
  27.                 Else
  28.                     f = Application.Match(key, Rows(5), 0)
  29.                     If IsError(f) Then
  30.                         f = Range("iv5").End(xlToLeft).Column + 1
  31.                         Cells(5, f) = key
  32.                     End If
  33.                     Cells(r, f) = d(key)
  34.                 End If
  35.             Next
  36.             r = r + 1
  37.         'End If
  38.     Next
  39.     Set FS = Nothing
  40.     Set d = Nothing
  41.     Exit Sub
  42. aa:
  43.     MsgBox "陣列 Ar 第" & i & "筆資料排列異常" & Ar(i)
  44.     Resume Next
  45. End Sub
複製代碼

TOP

感謝
發現一個有趣的問題,這個程式碼只要兩個檔案放在一起就可以執行。
我試著把他們
放在C->ok
放在C的目錄內 ->ok
放在桌面的目錄內->ok
放在桌面  ->就出現 『輸入已超過檔案結尾』
以上是題外話。
還是感謝Hsieh, GBKEE的幫忙,我在研究看看,再回饋回來。
50 字節以內
不支持自定義 Discuz! 代碼

TOP

回復 7# GBKEE
  1.     Ar = Split(Replace(FS.READALL, Chr(10), ""), "}")  '讀取資料存入陣列 Ar
複製代碼
改成
  1.     Ar = Split(Replace(FS.READALL, Chr(10), ""), ";}")  '讀取資料存入陣列 Ar
複製代碼
就不會出現格式錯誤

不過又發現有物品的代碼是用到{或者},因此又影響到程式的判斷
  1. Ar1 = Split(Ar(i), "{")
複製代碼
改成
  1. Ar1 = Split(Ar(i), ":{")
複製代碼
所以最後程式變成
  1. Sub Ex()
  2.     Dim FS As Object, d As Object, i%, ii%, Ar, Ar1, Ar2
  3.     Dim f
  4.     Set FS = CreateObject("Scripting.FileSystemObject").OpenTextFile(ThisWorkbook.Path & "\units.txt", 1, -2) 'TextStream 物件->加快對檔案的順序存取。
  5.     Ar = Split(Replace(FS.READALL, Chr(10), ""), ";}")  '讀取資料存入陣列 Ar
  6.     FS.Close                             ' 將檔案關閉。
  7.     [a5:iv65536] = ""
  8.     On Error GoTo aa
  9.     r = 6
  10.     For i = 0 To UBound(Ar)
  11.         Set d = CreateObject("Scripting.Dictionary")
  12.         'If InStr(Ar(i), ":{") Then
  13.             Ar1 = Split(Ar(i), ":{")
  14.             If i = 0 Then
  15.                 d("Name") = Split(Ar1(1), """")(1)
  16.                 Ar2 = Split(Ar1(2), """")
  17.             Else
  18.                 d("Name") = Split(Ar1(0), """")(1)
  19.                 Ar2 = Split(Ar1(1), """")
  20.             End If
  21.             For ii = 1 To UBound(Ar2) - 4 Step 4
  22.                 d(Ar2(ii)) = Ar2(ii + 2)
  23.             Next
  24.             For Each key In d
  25.                 If key = "Name" Then
  26.                     Cells(r, 1) = d(key)
  27.                 Else
  28.                     f = Application.Match(key, Rows(5), 0)
  29.                     If IsError(f) Then
  30.                         f = Range("iv5").End(xlToLeft).Column + 1
  31.                         Cells(5, f) = key
  32.                     End If
  33.                     Cells(r, f) = d(key)
  34.                 End If
  35.             Next
  36.             r = r + 1
  37.         'End If
  38.     Next
  39.     Set FS = Nothing
  40.     Set d = Nothing
  41.     Exit Sub
  42. aa:
  43.     MsgBox "陣列 Ar 第" & i & "筆資料排列異常" & Ar(i)
  44.     Resume Next
  45. End Sub
複製代碼
這樣子修正之後 一般就是最後一行會出問題
再者因為後面的字串 設計者似乎也沒有照前面的遊戲規則走
出現類似 名稱 + iconurl
s:9:"Q34_Giver";a:1:{s:7:"iconurl";s:46:"assets/SocialMissions/SM_avatar_spahostess.png";}

或者僅   code + iconurl
s:3:"Q34";a:1:{s:7:"iconurl";s:53:"assets/newsfeed/socialmissions_wishyouloveperfume.png";}
而且並沒有明確標示 是名稱或者是code,這樣子就沒辦法用程式判斷
所以 個人是覺得這個問題 可以算是結案了  因為後面一些陣列算是比較特殊性的東西 是可以忽略不計
再次感謝 兩位大大地鼎力幫忙,這次的問題 讓我學到不東西:lol :lol
50 字節以內
不支持自定義 Discuz! 代碼

TOP

回復 2# Hsieh


    版主感謝你的幫忙,第一次發帖,不知道要直接按文章下方的回貼,補上這一篇,謝謝你的幫忙,這個問題解決了。
50 字節以內
不支持自定義 Discuz! 代碼

TOP

        靜思自在 : 靜坐常恩己過、閒談莫論人非。
返回列表 上一主題