PJChen

回復 40# Hsieh
大人,
檔案中金額或數量若出現        錯誤訊息,例:#REF!,如何讓它依然填在PI_PO Records檔案中?我事後再去查看問題就好了,否則程會停滯不執行!

回復 38# oobird
oobird大大:
因為您寫的程式完全不會顯示正在run哪一筆,所以每當出現以下的對話框,我真不知是什麼問題?且因為有很多檔案有這種情形(我無法得知是哪一個?),能否就只是讓程式自動選擇不要更新且自動往下執行?否則程式在run時必須一直等在電腦前按"不更新"!

下載 (52.68 KB)

2012-5-19 00:33

oobird

Application.DisplayAlerts = False
Application.AskToUpdateLinks = False
這兩行一起用試試

Hsieh

回復 41# PJChen

1. Sub get_value()
   
2. Dim Sh As Worksheet, a As Range, Ar(), B As Range, B1 As Range
   
3. Set d = CreateObject("Scripting.Dictionary")
   
4. Application.ScreenUpdating = False
   
5. Application.DisplayAlerts = False
   
6. fd = ThisWorkbook.Path & "\" & "PI_PO\"
   
7. fs = Dir(fd & "*xls*")
   
8. Do Until fs = ""
   
9. With Workbooks.Open(Filename:=fd & fs, UpdateLinks:=False)
   
10. n = Split(fs, " ")(0)
    
11. s = InStr(n, "BCM") + 3
    
12. fn = Mid(n, s)
    
13.    For Each Sh In .Sheets
    
14.       With Sh
    
15.       If Trim(.Name) <> "PO" And Trim(.Name) <> "PI" Then GoTo 10
    
16.       ay = .UsedRange.Value
    
17.       For i = 1 To UBound(ay)
    
18.          mystr = ""
    
19.          For j1 = 1 To UBound(ay, 2)
    
20.             mystr = IIf(mystr = "", UCase(Trim(.Cells(i, j1).Text)), mystr & Chr(10) & UCase(Trim(.Cells(i, j1).Text)))
    
21.          Next
    
22.          If Trim(Replace(mystr, Chr(10), "")) Like "TOTAL*PCS?*" Then
    
23.          ak = Split(mystr, "PCS")
    
24.          ax = Split(Trim(ak(0)), Chr(10))
    
25.          ap = Split(Trim(ak(1)), Chr(10))
    
26.                d(Trim(.Name) & "數量") = ax(UBound(ax) - 1)
    
27.                d(Trim(.Name) & "金額") = ap(2)
    
28.                Exit For
    
29.          End If
    
30.       Next
    
31.       End With
    
32. 10
    
33.     Next
    
34.     ReDim Preserve Ar(y)
    
35.     Ar(y) = Array(fn, d("PI數量"), d("PI金額"), d("PO數量"), d("PO金額"), fs)
    
36.     y = y + 1
    
37.     .Close
    
38.     d.RemoveAll
    
39. End With
    
40. fs = Dir
    
41. Loop
    
42. Sheets("Records").[A2].Resize(y, 6) = Application.Transpose(Application.Transpose(Ar))
    
43. Application.ScreenUpdating = True
    
44. Application.DisplayAlerts = True
    
45. End Sub

複製代碼

PJChen

回復 42# oobird

大大,
果然不會再出現詢問的對話框了.

PJChen

回復 43# Hsieh

老大,

40樓的程式抓到的資料比較完整.
這次修改的雖然可以將#REF! 這種儲存格的資料依然填入PI_PO Records中不會再停滯不執行,但有其他以往抓得到的資料現在卻無法抓到!
能否以40樓的程式為基礎,只要小小的修改不會因為亂碼的數值?(如前面所提#REF! )而停滯不執行?