麻辣家族討論版版 - Powered by Discuz! Board

Option Explicit
Sub Ex()
Dim Sh As Worksheet, AR(1 To 2), Rng As Range, R As Integer, i As Integer
AR(1) = Array("H", "I", "L", "M") 'summary-2014 中的欄位
For Each Sh In Workbooks("JZT BC-總表.xlsx").Sheets 'JZT BC-總表.xlsx活頁簿 Sheets(物件集合)
With Sh
With .[A:A].Find("Total", LOOKAT:=xlWhole) '尋找A欄中的"Total"
.Cells(1, "B").Name = "QTY" '位於B欄的存存格命名
.Cells(1, "I").Name = "TotalPrice" '位於I欄的存存格命名
End With
AR(2) = Array(.[QTY], .[TotalPrice], .[B24], .[C25])
With Workbooks("Order List 2014_0502.xls").Sheets("'summary-2014")
R = .Cells(.Rows.Count, "H").End(xlUp).Offset(1).Row 'H欄:檔案底部往上有資料下一列的列號
'*** Order List 2014_0502.xls H欄中 10:65536 間還有資料請清除 ***
For i = 0 To 3
.Range(AR(1)(i) & R) = AR(2)(i)
Next
End With
End With
Next
End Sub

複製代碼

Sub Update_Data()
Dim Ar()
fs = ThisWorkbook.Path & "\JZT BC-總表.xlsx"
With Workbooks.Open(fs)
For Each sh In .Sheets
With sh
a = .Columns("A").Find("Total", lookat:=xlWhole).Offset(, 1).Value
b = .Columns("H").Find("Total amount", lookat:=xlWhole).Offset(, 1).Value
c = .Columns("A").Find("DELIVERY: ", lookat:=xlWhole).Offset(, 1).Value
d = .Columns("A").Find("IN WAREHOUSE DATE: ", lookat:=xlWhole).Offset(, 2).Value
ReDim Preserve Ar(s)
Ar(s) = Array(CStr(.Name), "", "", a, b, "", "", c, d)
s = s + 1
End With
Next
.Close 0
End With
If s > 0 Then ThisWorkbook.Sheets("summary-2014").[E10].Resize(s, 9) = Application.Transpose(Application.Transpose(Ar))
End Sub

複製代碼