標題: 跨檔案修改地址 [打印本頁]

---

作者: hong912    時間: 2018-2-14 18:29     標題: 跨檔案修改地址

前輩們, 好處
小弟有一修改地址問題請前輩們協助, 現附檔, 內有說明, 先行謝過..
祝賀前輩們及各版大, 新年快樂, 身體健康..
[attach]28373[/attach]

---

作者: Kubi    時間: 2018-2-27 10:47

回復 1# hong912
請參考。
[attach]28394[/attach]

---

作者: hong912    時間: 2018-2-28 07:15

回復 2# Kubi
大大, 早晨
感謝回應, 祝願新一年身體健, 萬事如意..

---

作者: Hsieh    時間: 2018-3-1 10:49

回復 1# hong912

1. Sub 地址更新()
   
2. '兩檔案置於同一目錄
   
3. Dim A As Range, Wk As Workbook, Sh As Worksheet, d As Object, yn As Integer
   
4. Set d = CreateObject("Scripting.Dictionary")
   
5. Set Wk = Workbooks.Open(ThisWorkbook.Path & "\" & "地址記錄表.xlsm")
   
6. For Each Sh In Wk.Sheets
   
7.    With Sh
   
8.       For Each A In .Range(.[A2], .[A2].End(xlDown))
   
9.         d(A.Value) = Array(A.Offset(, 1), Sh.Name, A.Offset(, 1).Address)
   
10.       Next
    
11.    End With
    
12. Next
    
13. With ThisWorkbook.Sheets(1)
    
14.   If d.exists(.[B25].Value) And d(.[B25].Value)(0) <> .[B26] Then
    
15.      yn = MsgBox("地址不同，是否更新?", vbYesNo)
    
16.      If yn = 6 Then
    
17.         Wk.Sheets(d(.[B25].Value)(1)).Range(d(.[B25].Value)(2)) = .[B26]
    
18.         Wk.Close 1
    
19.         Else
    
20.         Wk.Close 0
    
21.      End If
    
22.   End If
    
23. End With
    
24. End Sub

複製代碼

---

作者: hong912    時間: 2018-3-1 23:03

本帖最後由 hong912 於 2018-3-1 23:04 編輯

回復 4# Hsieh
謝謝版大回應,
小弟衷心感謝, 於此祝願身體健康..謝謝..

---

歡迎光臨 麻辣家族討論版版 (http://forum.twbts.com/)