我有两个同名的Excel工作簿,但有一个是通过网址打开的:
练习册54.xlsm
Column A Column B Column C
--------------------------------------
01/12/2016 12345 Notes
03/12/2016 23456 Notes
01/12/2016 78643 Notes
03/12/2016 12345 Notes
练习册54.xlsm
Column A Column B Column C
-------------------------------------
01/12/2016 12345
03/12/2016 23456
01/12/2016 78643
03/12/2016 12345
我正在尝试在线打开最新版本的Workbook 54,并且本质上希望能够从第一个(较旧)版本的Workbook 54中复制C列中的注释,并将这些注释粘贴到最新版本的工作簿54中。列B中的数字匹配,列a中的日期匹配。
到目前为止,这是我的代码,由于某些原因,我放在一起似乎没有做任何事情。
'Download File - Check URL
Sub File()
Dim wb As Workbook
Dim dt As Date
dt = Now
Const sURL As String = "https://intranet-uk.lidl.net/info-centre/docsdb/Document%20Database/08.%20Buying/8.3%20Food%20Specials/Current%20Information/Food%20Specials%20and%20Seasonal%20Depot%20Memos/"
On Error Resume Next
Application.DisplayAlerts = False
Set wb = Workbooks.Open(sURL & "Food%20Specials%20Rolling%20Depot%20Memo%2045%20-%2052.xlsm")
Application.DisplayAlerts = True
On Error GoTo 0
If wb Is Nothing Then
Set wb = Workbooks.Open(sURL & "Food%20Specials%20Rolling%20Depot%20Memo%2046%20-%2001.xlsm")
End If
Set GetCFWorkbook = wb
Dim Dic As Object, key As Variant, oCell As Range, i&
Dim w1 As Worksheet, w2 As Worksheet
Set LookupWB = Application.Workbooks("Food Specials Rolling Depot Memo 46 - 01.xlsm")
Set Dic = CreateObject("Scripting.Dictionary")
Set w2 = ThisWorkbook.Sheets("Sheet1")
Set w1 = Workbooks(LookupWB).Sheets("Sheet1")
i = w1.Cells.SpecialCells(xlCellTypeLastCell).Row
For Each oCell In w1.Range("J6:J" & i)
If Not Dic.exists(oCell.Value) Then
Dic.Add oCell.Value, oCell.Offset(, -3).Value
End If
Next
i = w2.Cells.SpecialCells(xlCellTypeLastCell).Row
For Each oCell In w2.Range("J6:J" & i)
For Each key In Dic
If oCell.Value = key Then
oCell.Offset(, 2).Value = Dic(key)
End If
Next
Next
End Sub