- 帖子
- 4901
- 主題
- 44
- 精華
- 24
- 積分
- 4916
- 點名
- 97
- 作業系統
- Windows 7
- 軟體版本
- Office 20xx
- 閱讀權限
- 150
- 性別
- 男
- 來自
- 台北
- 註冊時間
- 2010-4-30
- 最後登錄
- 2024-4-26
              
|
43#
發表於 2012-5-19 14:48
| 只看該作者
本帖最後由 Hsieh 於 2012-5-19 14:49 編輯
回復 41# PJChen - Sub get_value()
- Dim Sh As Worksheet, a As Range, Ar(), B As Range, B1 As Range
- Set d = CreateObject("Scripting.Dictionary")
- Application.ScreenUpdating = False
- Application.DisplayAlerts = False
- fd = ThisWorkbook.Path & "\" & "PI_PO\"
- fs = Dir(fd & "*xls*")
- Do Until fs = ""
- With Workbooks.Open(Filename:=fd & fs, UpdateLinks:=False)
- n = Split(fs, " ")(0)
- s = InStr(n, "BCM") + 3
- fn = Mid(n, s)
- For Each Sh In .Sheets
- With Sh
- If Trim(.Name) <> "PO" And Trim(.Name) <> "PI" Then GoTo 10
- ay = .UsedRange.Value
- For i = 1 To UBound(ay)
- mystr = ""
- For j1 = 1 To UBound(ay, 2)
- mystr = IIf(mystr = "", UCase(Trim(.Cells(i, j1).Text)), mystr & Chr(10) & UCase(Trim(.Cells(i, j1).Text)))
- Next
- If Trim(Replace(mystr, Chr(10), "")) Like "TOTAL*PCS?*" Then
- ak = Split(mystr, "PCS")
- ax = Split(Trim(ak(0)), Chr(10))
- ap = Split(Trim(ak(1)), Chr(10))
- d(Trim(.Name) & "數量") = ax(UBound(ax) - 1)
- d(Trim(.Name) & "金額") = ap(2)
- Exit For
- End If
- Next
- End With
- 10
- Next
- ReDim Preserve Ar(y)
- Ar(y) = Array(fn, d("PI數量"), d("PI金額"), d("PO數量"), d("PO金額"), fs)
- y = y + 1
- .Close
- d.RemoveAll
- End With
- fs = Dir
- Loop
- Sheets("Records").[A2].Resize(y, 6) = Application.Transpose(Application.Transpose(Ar))
- Application.ScreenUpdating = True
- Application.DisplayAlerts = True
- End Sub
|
|
發表於 2012-5-19 00:36
| 
