比较两个单元格时出现“运行时错误'13'：类型不匹配”-错误

Question

此宏的目的是根据两个标准将数据从许多输入工作表复制到名为“Kompensation test5”的主/主工作簿的工作表“基础”中。宏应该 1) 验证输入工作表是否与主工作簿在同一月份。如果是这样，2）它应该复制相关路线的相关数据。目前我得到了

Run-time error '13': Type mismatch

在第 58 行（代码中用大写字母注释）。这里有什么问题？

我已经上传了主工作簿的示例和其中一个输入工作簿的示例。输入工作簿的日期单元格（单元格 B9）通常具有后跟“-”的月份和年份，fx “February - 2016”。我在第 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

Answer 2

你需要在Cells(1, x)之后使用.Value

另请参阅以下内容：

当直接引用WorkBook 名称时，您需要包含扩展名。因此，您需要为文件“Kompensation test5”添加扩展名，使其成为“Kompensation test5.xls”或任何扩展名。

当您想要来自 Range 的值并且已经设置了 Range 时，您只需要使用 Range 名称和 .Value 因此对于第二行您只需要 rng_input_date.Value

所以第 58 行应该是这样的，假设“Kompensation test5”文件扩展名为 .xls

 If InStr(Workbooks("Kompensation test5.xlsm").Sheets("Basis").Cells(1, x).Value, Workbooks(ws_input).Range(rng_input_date).Value) > 0 Then 'ERROR HERE!
     k = x
 End If

但请记住，Split 函数会创建一个 Array，因此会出现类型不匹配。

您没有真正正确地比较“Kompensation test5”和“Mappe1”中的数据。请检查原始数据，让我们知道正在比较的单元格的数据，数据是一个单词还是 2015/02/19，其中仅显示月份。

您的For Loop 也将无法正常工作，因为您在“Kompensation test5”表中的月份名称仅在每 7 列中，因此您需要使用

For x = 1 To 100 Step 7

然后，当使用合并的单元格区域时，这将选择插入月份显示的单元格。