依指定欄位中的資料自動判定輸入對應的檔案資料中???
- 帖子
- 4901
- 主題
- 44
- 精華
- 24
- 積分
- 4916
- 點名
- 61
- 作業系統
- Windows 7
- 軟體版本
- Office 20xx
- 閱讀權限
- 150
- 性別
- 男
- 來自
- 台北
- 註冊時間
- 2010-4-30
- 最後登錄
- 2025-3-12
               
|
回復 8# p6703 - Sub Ex()
- Dim Ws(), A As Range, B As Range, s%, bs$, w As Window
- For Each w In Windows
- ReDim Preserve Ws(s)
- Ws(s) = w.Caption
- s = s + 1
- Next
- With ThisWorkbook.Sheets(1)
- For Each A In .Range(.[M2], .[M2].End(xlDown))
- bs = IIf(A = 1202, "A.xls", IIf(A = 1205, "B.xls", IIf(A = 1206, "C.xls", "")))
- If IsError(Application.Match(bs, Ws, 0)) Then Workbooks.Open ThisWorkbook.Path & "\" & bs: ReDim Preserve Ws(s): Ws(s) = bs: s = s + 1
- With Workbooks(bs)
- Set B = .Sheets(1).[A65536].End(xlUp).Offset(1)
- ar = Array(A.Offset(, -10).Value, IIf(A.Offset(, -12) = "IS" Or A.Offset(, -12) = "IN", 2, ""), Date, A.Offset(, -7).Value, A.Offset(, -3).Value, A.Offset(, -11).Value, B.Offset(, 6).FormulaLocal, A.Offset(, -9).Value, A.Offset(, -8).Value, B.Offset(, 9).FormulaLocal, A.Offset(, -5).Value)
- B.Resize(, 11).Value = ar
- End With
- Next
- End With
- End Sub
|
|
|
學海無涯_不恥下問
|
|
|
|
|
- 帖子
- 4901
- 主題
- 44
- 精華
- 24
- 積分
- 4916
- 點名
- 61
- 作業系統
- Windows 7
- 軟體版本
- Office 20xx
- 閱讀權限
- 150
- 性別
- 男
- 來自
- 台北
- 註冊時間
- 2010-4-30
- 最後登錄
- 2025-3-12
|
回復 10# p6703
ar = Array(A.Offset(, -10).Value, IIf(A.Offset(, -12) = "IS" Or A.Offset(, -12) = "IN", 2, ""), Date, A.Offset(, -7).Value, A.Offset(, -3).Value, A.Offset(, -11).Value, B.Offset(-1, 6).FormulaR1C1, A.Offset(, -9).Value, A.Offset(, -8).Value, B.Offset(-1, 9).FormulaR1C1, A.Offset(, -5).Value) |
|
|
學海無涯_不恥下問
|
|
|
|
|
發表於 2012-9-25 20:11
| 
