VBA：查找文件並將單元格值從一個工作簿中的列復制到另一個根據條件？

Question

我有一個像所謂的奴隸的電子表格：

Id    Delivery Date    Case Size   Receivings    Allocated 
1     12/12/2016       4           100           100
2     13/12/2016       5           200           50
3     11/10/2016       6           200           25
4     15/11/2014       3           90            10

我還有另一個完全相同的電子表格，但稱為主數據表。

Id    Delivery Date    Case Size   Receivings    Allocated 
1     12/12/2016       4                     
2     13/12/2016       5                      
3     11/10/2016       6                      
4     15/11/2014       3   

我正在嘗試從從工作簿復制到接收和分配的單位，再復制到ID，交貨日期和案例大小匹配的主工作簿。

到目前為止，這是我嘗試過的：

Sub GetTheName()
    Dim s As String, FileName As String

    s = "C:\Users\Mark O'Brien\Documents\*.xlsm"

    FileName = Dir(s)

    Do Until FileName = ""
        If FileName Like "Food Specials Rolling Depot Memo*" Then MsgBox FileName


        'Start Merge of Memo


Dim Dic As Object, key As Variant, oCell As Range, i&
    Dim w1 As Worksheet, w2 As Worksheet

    Set Dic = CreateObject("Scripting.Dictionary")
    Set w1 = Workbooks.Open(FileName).Sheets(1)
    Set w2 = ThisWorkbook.Sheets(1)

    i = w1.Cells.SpecialCells(xlCellTypeLastCell).Row

    For Each oCell In w1.Range("R10:R" & 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("F10:F" & i)
        For Each key In Dic
            If oCell.Value = key Then
                oCell.Offset(, 2).Value = Dic(key)
            End If
        Next
    Next

        'End Merge of Memo




        FileName = Dir()
        ActiveSheet.Range("A8").Value = Now()
    Loop


End Sub

除了工作鈎的開口，似乎什么都沒有發生。 不會復制任何內容，也不會給出錯誤。 請有人能告訴我我要去哪里錯嗎？ 謝謝

Answer 1

您可以使用AutoFilter()方法，如下所示：

Option Explicit

Sub main()
    Dim cell As Range, masterRng As Range

    With Sheets("MasterSheet") '<--| reference your "Master" sheet (change "MasterSheet" to your actual "Master" sheet name)
        Set masterRng = .Range("A2", .Cells(.Rows.count, 1).End(xlUp)) '<--| reference its columns A cells from row 2 down to last not empty row
    End With

    With Sheets("SlaveSheet") '<--| reference your "Slave" sheet (change "SlaveSheet" to your actual "Slave" sheet name)
        With .Range("C1", .Cells(.Rows.count, 1).End(xlUp)) '<--| reference its columns A and B range from row 1 (headers) down to column A last not empty row
            For Each cell In masterRng  '<--| loop through "Master" sheet column A "ID"
                .AutoFilter field:=1, Criteria1:=cell.Value '<--| filter referenced range on its 2nd column (i.e. column B) with current cell 1 column offset  value (i.e. current "Master" sheet "ID")
                .AutoFilter field:=3, Criteria1:=cell.Offset(, 2).Value '<--| filter referenced range on its 3rd column (i.e. column C) with current cell 2 columns offset value (i.e. current "Master" sheet "Case Size")
                If Application.WorksheetFunction.Subtotal(103, .Resize(, 1)) > 1 Then '<--| if any cell filtered other than headers
                    cell.Offset(, 3).Resize(, 2).Value = .Resize(.Rows.count - 1, 1).Offset(1, 3).SpecialCells(xlCellTypeVisible).Cells(1, 1).Resize(, 2).Value '<--|write first filtered 3rd column cell value in current cell offset 2 columns value (i.e. current "Master" sheet "Names")
                End If
            Next cell
        End With
        .AutoFilterMode = False
    End With
End Sub