- 帖子
- 4901
- 主題
- 44
- 精華
- 24
- 積分
- 4916
- 點名
- 142
- 作業系統
- Windows 7
- 軟體版本
- Office 20xx
- 閱讀權限
- 150
- 性別
- 男
- 來自
- 台北
- 註冊時間
- 2010-4-30
- 最後登錄
- 2026-7-16
                
|
2#
發表於 2012-4-21 00:15
| 只看該作者
回復 1# luke - Sub Ex()
- Dim fs$, Mystr$, A(0 To 7), Ay()
- Set d = CreateObject("Scripting.Dictionary")
- fs = Replace(ThisWorkbook.FullName, ".xls", ".csv")
- Open fs For Input As #1
- Do Until EOF(1)
- Line Input #1, Mystr
- If InStr(Mystr, "父項編號") > 0 Then
- fa = Split(Mystr, ":")
- f1 = Trim(Replace(fa(1), "父項名稱", "")): f2 = Trim(fa(2))
- End If
- Mystr = Trim(Mystr)
- If Val(Mystr) <> 0 Then
- m = Trim(Right(Mystr, 3)) '單位
- Mystr = Trim(Replace(Mystr, m, ""))
- k = Len(Mystr)
- Do Until Mid(Mystr, k, 1) = " "
- k = k - 1
- Loop
- n = Mid(Mystr, k) '數量
- Mystr = Trim(Left(Mystr, k))
- Mystr = Trim(Mid(Mystr, Len(Split(Mystr, " ")(0)) + 1))
- i = 1
- Do Until Mid(Mystr, i, 1) = " "
- i = i + 1
- Loop
- p = Trim(Left(Mystr, i)) '子項號
- w = Trim(Replace(Mystr, p, "")) '品名
- d(f2) = d(f2) + 1
- ReDim Preserve Ay(x)
- Ay(x) = Array(f1, f2, d(f2), p, w, n, m)
- x = x + 1
- End If
- Loop
- Sheet3.[A7].Resize(x, 7).Value = Application.Transpose(Application.Transpose(Ay))
- Close #1
- End Sub
|
|
發表於 2012-4-20 22:23
| 
