Question

我正在使用FileDialog选择其他工作簿。我想一次选择多个文件。

我是这样做的：

With fd

    .Filters.Clear
    .Filters.Add "Excel Files", "*.xls; *.xlsx; *.xlsb; *.xltx; *.xltm; *.xlt; *.xml; *.xlam; *.xla; *.xlw", 1
    .AllowMultiSelect = True
    If .Show = -1 Then

    For Each vrtSelectedItem In .SelectedItems

            'Extract the Filename (without its file extension) to the File Path
            nPath = Mid(vrtSelectedItem, InStrRev(vrtSelectedItem, "\") + 1)
            'nPath is Filename with path
            nFilename = Left(nPath, InStrRev(nPath, ".") - 1)

             If IsWorkBookOpen(vrtSelectedItem) = True Then
                    MsgBox "File already open."
             Else

                Set wrkbk = Workbooks.Open("" & vrtSelectedItem)
                Set wrkbk_destination = ThisWorkbook '<--- this where is will add the data from files selected with FD
                Set wrkbk_source = Workbooks("" & nFilename) '<--- this the selected files

         With wrkbk_destination.Sheets("Defect Log")
         .Activate

            ' I want to add the all values within range here but check if data already exist
            ' For example selected files have data within range of D11 : I11 , D12 : I12 and D13 : I13
            ' I want to add these but if data within D12 : I12 already exist It will skip adding data and continue with
            ' D13 : I13

                    End With

我只需要一个如何操作的示例，我将指出这些添加的数据将在wrkbk_destination中显示的位置。

Answer 1

几点意见

您可以取消对象wrkbk或wrkbk_source
您无需检查数据是否已存在。只需复制数据，因为只有一小部分D11:I13可以复制。最后使用.RemoveDuplicates。它会快得多。
您无需继续激活工作簿/工作表。您可以直接执行操作。您可能希望查看How to avoid using Select in Excel VBA macros

这是你正在尝试的（未经测试）

Sub Sample()
    '
    '~~> Rest of the code
    '

    Dim lRow As Long

    Set wrkbk_destination = ThisWorkbook

    With fd
        .Filters.Clear
        .Filters.Add "Excel Files", "*.xls; *.xlsx; *.xlsb; *.xltx;" & _
        "*.xltm; *.xlt; *.xml; *.xlam; *.xla; *.xlw", 1

        .AllowMultiSelect = True

        If .Show = -1 Then

        For Each vrtSelectedItem In .SelectedItems
             If IsWorkBookOpen(vrtSelectedItem) = True Then
                MsgBox "File already open."
             Else
                Set wrkbk_source = Workbooks.Open(vrtSelectedItem)

                With wrkbk_destination.Sheets("Defect Log")
                    lRow = .Range("D" & .Rows.Count).End(xlUp).Row + 1

                    .Range("D" & lRow & ":I" & (lRow + 2)).Value = _
                    wrkbk_source.Sheets(1).Range("D11:I13").Value
                End With

                wrkbk_source.Close (False)
            End If
        Next vrtSelectedItem
    End With

    With wrkbk_destination.Sheets("Defect Log")
        lRow = .Range("D" & .Rows.Count).End(xlUp).Row

        '~~> Change xlNo to xlYes if the column has headers
        .Columns("D1:I" & lRow).RemoveDuplicates Columns:= _
        Array(1, 2, 3, 4, 5, 6), Header:=xlNo
    End With
End Sub

添加范围内的所有数据，然后检查它是否已存在

1 个答案: