- 帖子
- 140
- 主題
- 24
- 精華
- 0
- 積分
- 167
- 點名
- 0
- 作業系統
- WIN 7
- 軟體版本
- OFFICE 2007
- 閱讀權限
- 20
- 性別
- 男
- 註冊時間
- 2012-2-26
- 最後登錄
- 2023-1-30
|
4#
發表於 2019-7-1 23:56
| 只看該作者
謝謝准提部林版大提供!
http://forum.twbts.com/viewthrea ... t%A4%40%C0%C9%AE%D7
請教各位大大，如何改寫在附件中?(每當E2有改變時，在D:\VBA\記錄.xlsx的Sheet1中，按時序由A2至D2向下，記錄每組C2至F2)
Sub TEST()
Dim A As Range, B As Range, N%
Dim X As New Application, FN$, xB As Workbook
For Each A In [F4:G4]
N = N + 1
FN = ThisWorkbook.Path & "\" & A.Value & "記錄.xlsx"
If Dir(FN) = "" Then GoTo 101
Set xB = X.Workbooks.Open(FN)
For Each B In [E5:E14]
On Error Resume Next
If Range(B.Value) Is Nothing Then GoTo 102
On Error GoTo 0
xB.Sheets(1).Range(B).Value = B(1, N + 1)
102: Next
xB.Close 1
101: Next
End Sub
 test1.rar (18.67 KB)
|
|
