vba - 比较两个单元格时获取 “Run-time error ' 1 3': Type mismatch”-错误

Question

此宏的目的是基于两个条件将数据从许多输入工作表复制到主/主工作簿的工作表“基础”(称为“Kompensation test5”)。该宏应1)验证输入表是否与主工作簿在同一月份。如果是这样，2)它应该复制相关路线的相关数据。目前我正在
Run-time error '13': Type mismatch
在第58行(用代码中的大写字母注释)。怎么了

我已经上传了主要工作簿的示例以及其中一个输入工作簿的示例。输入工作簿的日期单元格(单元格B9)通常在月份后跟“-”，年份则是fx“2016年2月”。我在第58行上对其进行了拆分，以使其可与主要工作簿中“基本”表第一行中的月份进行比较。

Sub combineall()

    Application.EnableEvents = False
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    Application.Calculation = xlCalculationManual

    Call lista
    Call CopyLookup

    Application.CutCopyMode = False
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic
    Application.EnableEvents = True

    Workbooks("Kompensation test5").Sheets("List").Delete
    Workbooks("Kompensation test5").Sheets("Basis").Activate

End Sub


Sub CopyLookup()
    Dim Path As String
    Dim Fil As String
    Dim strName As String
    Dim wbk_main As Workbook, wbk_input As Workbook
    Dim ws_main As Worksheet, ws_input As Worksheet
    Dim rng_main As Range, rng_main_date As Range, rng_input As Range, rng_input_date As Range
    Dim c_main As Range, c_main_date As Range, c_input As Range
    i = 2

    While Workbooks("Kompensation test5").Sheets("List").Cells(i, 1) <> ""
    t = Workbooks("Kompensation test5").Sheets("List").Cells(i, 1)

    Set wbk_main = ActiveWorkbook
    Path = "I:\folderpath" & t

    q = 1
     'Start outer loop
    Do While q <> ""

        Set wbk_input = Workbooks.Open(Path)
        Set ws_input = wbk_input.Sheets(1)

        Set rng_main_date = ThisWorkbook.Sheets("Basis").Range("1:1")
        Set rng_input_date = ws_input.Range("B9")

        Set rng_input = ws_input.Range("R10:AL10")

        For Each c_main_date In rng_main_date
            If c_main_date.Value <> "" Then
                For Each c_input In rng_input_date
                    If c_input.Value <> "" Then
                        For x = 1 To 100
                        If InStr(Workbooks("Kompensation test5").Sheets("Basis").Cells(1, x), Split(Replace(Workbooks(ws_input).Range(rng_input_date).Value, "-", " "), " ")) > 0 Then 'ERROR HERE!
                            k = x
                        End If
                        Next x
                        Workbooks("Kompensation test5").Sheets("Basis").Range(Cells(4, k - 1), Cells(19, k - 1)).Select
                    End If
                Next c_input
            End If
        Next c_main_date

        Set rng_main = Workbooks("Kompensation test5").Sheets("Basis").Range(Cells(4, k - 1), Cells(19, k - 1))

         'Split cell if containing many values
        ws_input.Range("B10").Select
        Selection.TextToColumns Destination:=Range("R10"), DataType:=xlDelimited, _
        TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, _
        Semicolon:=False, Comma:=True, Space:=False, Other:=False, FieldInfo _
        :=Array(Array(1, 1), Array(2, 1), Array(3, 1), Array(4, 1), Array(5, 1), Array(6, 1), _
        Array(7, 1), Array(8, 1), Array(9, 1), Array(10, 1), Array(11, 1), Array(12, 1)), _
        TrailingMinusNumbers:=True

         'Loop through each cell in col I in sheet 2:
        For Each c_main In rng_main
            If c_main.Value <> "" Then
                For Each c_input In rng_input
                    If c_input.Value = c_main.Value Then
                        c_main.Offset(0, 3).Value = wbk_input.Sheets(1).Range("F13").Value
                        q = ""
                         'Move on to next cell in sheet 2:
                        Exit For '(exits the "For Each c_input In rng_input" loop)
                    End If
                Next c_input
            End If
        Next c_main

        rng_input.Delete
        wbk_input.Close False

    Loop

    i = i + 1
    Wend

End Sub

Sub lista()
    Dim objFSO As Object
    Dim objFolder As Object
    Dim objFile As Object
    Dim ws As Worksheet

    Set objFSO = CreateObject("Scripting.FileSystemObject")
    Set ws = Worksheets.Add
    With ActiveSheet
    .Name = "List"
    End With

    fldrpath = "I:\folderpath"
    Set objFolder = objFSO.GetFolder(fldrpath)
    ws.Cells(1, 1).Value = "The files found in " & objFolder.Name & "are:"

    For Each objFile In objFolder.Files
        ws.Cells(ws.UsedRange.Rows.Count + 1, 1).Value = objFile.Name
    Next

    Set objFolder = Nothing
    Set objFile = Nothing
    Set objFSO = Nothing
End Sub

Answer 1

您忘记了引用工作簿中的工作表

Workbooks(ws_input).Range(rng_input_date).Value

应该

Workbooks(ws_input).Sheets("SHEETNAME").Range(rng_input_date).Value

并确保:

Workbooks("Kompensation test5").Sheets("Basis").Cells(1, x).Value

代替

Workbooks("Kompensation test5").Sheets("Basis").Cells(1, x)

如果仍然无法解决问题，那是因为您正在将范围的值与单元格的值进行比较，因此请进行更改

Workbooks(ws_input).Sheets("SHEETNAME").Range(rng_input_date).Value

至

Workbooks(ws_input).Sheets("SHEETNAME").Cells(9,2).Value 'If your Date is in Cell B9