- 帖子
- 913
- 主題
- 150
- 精華
- 0
- 積分
- 1089
- 點名
- 0
- 作業系統
- win10
- 軟體版本
- office 2019
- 閱讀權限
- 50
- 性別
- 女
- 註冊時間
- 2011-8-28
- 最後登錄
- 2023-7-19
 
|
回復 38# oobird
回復 35# Hsieh
老大,請問你是否回答我第37樓的問題?若是的話:
歸究起來是檔案太多不同格式所造成的問題,若是TOTAL的問題,我想很多欄位都會用這個字,若我統一只採用"TOTAL:"(是有冒號的),則以下這2個程式上我應該如何修改?該它只在看到"TOTAL:"的情形下才作動作?(二個程式各有它好用用的地方,我都想修改它)- 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 & "\" & "2011 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
- For Each c In .Range("A:B").SpecialCells(xlCellTypeConstants)
- If c Like "TOTAL*" Then Set a = c: Exit For
- Next
- If Not a Is Nothing Then
- Set B = a.EntireRow.Find("pcs")
- Set B1 = a.EntireRow.Find("*", after:=B)
-
- If Not B Is Nothing Then
- d(Trim(.Name) & "數量") = B.Offset(, -1)
- c1 = a.EntireRow.Find("*", after:=B1)
- d(Trim(.Name) & "金額") = c1
- End If
- End If
- Set a = Nothing
- 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
- Sub get_value_F()
- Dim a As Range, arr(1 To 5)
- Application.ScreenUpdating = False '關閉螢幕閃爍
- For Each a In Range([f2], [f2].End(4)) '在f2以下的資料範圍循環
- If Application.CountA(Rows(a.Row)) = 1 Then 'a:e欄已有寫入資料就跳過
- Application.DisplayAlerts = False '關閉開啟時的對話方塊
- fb = ThisWorkbook.Path & "\2011 PI_PO\" & a '從"PI_PO資料夾"取路徑
- Set wk = GetObject(fb) '背景開啟該路徑檔案
- Sh = Array("PI", "PO") '兩個工作表名
- On Error Resume Next '略過錯誤
- For s = 0 To 1
- Set mysheet = wk.Sheets(Sh(s)) '工作表變量
- If Err.Number = 0 Then '如不發生錯誤(有這個工作表)
- mysheet.AutoFilterMode = False '取消篩選
- mysheet.[a:b].Replace "TOTAL:", "TOTAL", xlWhole '把帶分號的TOTAL改成不帶分號
- r = mysheet.[a:b].Find("TOTAL", , , 1, xlByRows).Row '在AB兩欄尋找"TOTAL"
- c = mysheet.Cells(r, 15).End(1).Column '取TOTAL那一行的最右欄(即金額)
- arr(1) = Split(a, " ")(0) '取f欄第一個空格以前的字串
- arr(s * 2 + 2) = mysheet.Cells(r, c - 3).Value '取最右欄減3欄的數字
- arr(s * 2 + 3) = mysheet.Cells(r, c).Value '取最右欄的數字
- End If
- Err.Clear '清除錯誤
- Next
- Cells(a.Row, 1).Resize(1, 5) = arr '寫入儲存格
- Erase arr
- wk.Close 0 '關閉打開的檔案不儲存
- End If
- Next
- End Sub
|
|
發表於 2012-5-18 14:46
| 
