- 帖子
- 4901
- 主題
- 44
- 精華
- 24
- 積分
- 4916
- 點名
- 120
- 作業系統
- Windows 7
- 軟體版本
- Office 20xx
- 閱讀權限
- 150
- 性別
- 男
- 來自
- 台北
- 註冊時間
- 2010-4-30
- 最後登錄
- 2025-5-18
               
|
4#
發表於 2018-3-1 10:49
| 只看該作者
回復 1# hong912 - Sub 地址更新()
- '兩檔案置於同一目錄
- Dim A As Range, Wk As Workbook, Sh As Worksheet, d As Object, yn As Integer
- Set d = CreateObject("Scripting.Dictionary")
- Set Wk = Workbooks.Open(ThisWorkbook.Path & "\" & "地址記錄表.xlsm")
- For Each Sh In Wk.Sheets
- With Sh
- For Each A In .Range(.[A2], .[A2].End(xlDown))
- d(A.Value) = Array(A.Offset(, 1), Sh.Name, A.Offset(, 1).Address)
- Next
- End With
- Next
- With ThisWorkbook.Sheets(1)
- If d.exists(.[B25].Value) And d(.[B25].Value)(0) <> .[B26] Then
- yn = MsgBox("地址不同，是否更新?", vbYesNo)
- If yn = 6 Then
- Wk.Sheets(d(.[B25].Value)(1)).Range(d(.[B25].Value)(2)) = .[B26]
- Wk.Close 1
- Else
- Wk.Close 0
- End If
- End If
- End With
- End Sub
|
|
發表於 2018-2-14 18:29
| 
