来自列的VBA查找值以及是否与其他工作簿匹配,将相应的单元格值复制到其他工作簿中?

时间:2016-12-03 09:39:07

标签: excel vba

我有两个同名的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

0 个答案:

没有答案