VBA Excel 2016：类型不匹配错误

Question

我正在尝试复制名为“所有组”的工作表上的整行数据（从A到AF），如果AG列包含特定值，则将其粘贴到名为“绿色”的工作表中（如果AG = 1，蓝色如果AG = 2，红色如果AG = 3）。

然而，我遇到了“类型不匹配错误”。

我在论坛和互联网上寻找类似错误的帖子，但是我没有找到能够帮助我的答案。我正在使用Excel 2016，下面是我的代码：

     Sub sort()
    Dim LSearchRow As Integer
    Dim LCopyToRow As Integer

Worksheets("All groups").Select
'Start search in row 3
    LSearchRow = 3
'Start copying data to row 3 in Destination Sheet (row counter variable)
    LCopyToRow = 3
    While Len(Range("A" & CStr(LSearchRow)).Value) > 0
'If value in column AG = "1", copy and paste entire row to Green. Then go back and continue searching
        If Range("AG" & CStr(LSearchRow)).Value = "1" Then
            Rows(CStr(LSearchRow) & "A:AF" & CStr(LSearchRow)).Select
            Selection.Copy
            Worksheets("Green").Select
            Rows(CStr(LCopyToRow) & "A:AF" & CStr(LCopyToRow)).Select
            ActiveSheet.Paste
            LCopyToRow = LCopyToRow + 1
            Worksheets("All groups").Select

'If value in column AG = "2", copy and paste entire row to Blue. Then go back and continue searching
        ElseIf Range("AG" & CStr(LSearchRow)).Value = "2" Then
            Rows(CStr(LSearchRow) & "A:AF" & CStr(LSearchRow)).Select
            Selection.Copy
            Worksheets("Blue").Select
            Rows(CStr(LCopyToRow) & "A:AF" & CStr(LCopyToRow)).Select
            ActiveSheet.Paste
            LCopyToRow = LCopyToRow + 1
            Worksheets("All groups").Select

'If value in column AG = "3", copy and paste entire row to Red. Then go back and continue searching
        Else
            Rows(CStr(LSearchRow) & "A:AF" & CStr(LSearchRow)).Select
            Selection.Copy
            Worksheets("Red").Select
            Rows(CStr(LCopyToRow) & "A:AF" & CStr(LCopyToRow)).Select
            ActiveSheet.Paste
            LCopyToRow = LCopyToRow + 1
            Worksheets("All groups").Select
            End If

        Wend

        End Sub

- Dr. Steinberg

---

我只得到了一个“运行时错误13类型不匹配”的提示。它没有显示出错的行号，也没有将其标记出来。顺便说一下，当我尝试使用Rows(CStr(LSearchRow) & ":" & CStr(LSearchRow))时，我遇到了一个应用程序定义或对象定义的错误。 - Dr. Steinberg

Rows(...语句很奇怪...无论如何，由于您没有突出显示的行，我建议您在几乎每一行上设置断点，以缩小罪魁祸首所在的行。您习惯这样调试吗？如果不是，我会为您尝试提供一个经过策划的解决方案！;) - R3uK

我对VBA还比较新，所以以前从未像这样进行过调试 :) 通常情况下，VBA Excel会突出显示发生错误的行。但是在这个特定的错误上，它没有突出显示导致错误的行。 - Dr. Steinberg

这可能是一个愚蠢的问题，但你的数据集有多大？你有多少行数据？ - R3uK

159行是我的数据集。 - Dr. Steinberg

Answer 1

您在进行CStr数字转文本的过程中有些过于热情了，这样做可能会导致数字和文本的混淆。应该将数字视为数字，将文本视为文本。交叉匹配可能会产生预期之外的结果。

我找不到您增加LSearchRow变量的地方，因此我已经添加了它。

Sub all_group_sort()
    Dim LSearchRow As Long
    Dim LCopyToRow As Long

    With Worksheets("All groups")
        'Start search in row 3
        LSearchRow = 3

        'Start copying data to row 3 in Destination Sheet (row counter variable)
        LCopyToRow = 3  '= LSearchRow
        While CBool(Len(Range("A" & LSearchRow).Value2))
            'If value in column AG = "1", copy and paste entire row to Green. Then go back and continue searching
            Select Case CStr(.Range("AG" & LSearchRow).Value2)
                Case "1"
                    .Cells(LSearchRow, "A").Resize(1, 32).Copy _
                        Destination:=Worksheets("Green").Cells(LCopyToRow, "A")
                    LCopyToRow = LCopyToRow + 1
                Case "2"
                    .Cells(LSearchRow, "A").Resize(1, 32).Copy _
                        Destination:=Worksheets("Blue").Cells(LCopyToRow, "A")
                    LCopyToRow = LCopyToRow + 1
                Case "3"
                    .Cells(LSearchRow, "A").Resize(1, 32).Copy _
                        Destination:=Worksheets("Red").Cells(LCopyToRow, "A")
                    LCopyToRow = LCopyToRow + 1
                Case Else
                    'do nothing
                    Debug.Print "Not 1,2 or 3 - " & .Range("AG" & LSearchRow).Value2
            End Select
            LSearchRow = LSearchRow + 1
        Wend
    End With
End Sub

这种标准检查可以通过Select Case语句很好地处理。实际的复制只需要一个单元格作为目标；其余的粘贴会自动跟随它。

- user4039065

Answer 2

你不需要在每个地方都使用CStr，因为VBA会将整个字符链隐式转换为字符串，因为它是连接（字符串相加），并且期望有一个字符串参数。

此外，.Select是一个非常重的方法，在绝大多数情况下完全没有用处，所以我摆脱了它们！

我添加了工作表变量（注意Set关键字来分配对象值），将If改为Select Case，并将不必要的内容放入了If中。

最后，我更改了粘贴行的计算方式，使其成为每个工作表中的第一行空行！

这是您的代码稍微转换了一下，但它分解了整个过程的每个步骤，请让我知道是否正常工作：

Sub sort()
Dim wS As Worksheet, _
    wsDest As Worksheet, _
    LSearchRow As Integer, _
    LCopyToRow As Integer

Set wS = Sheets("All groups")
LSearchRow = 3      'Start search in row 3
LCopyToRow = 3      'Start copying data to row 3 in Destination Sheet (row counter variable)

With wS
    While Len(CStr(.Range("A" & LSearchRow).Value)) > 0
        'Copy the row
        .Rows(LSearchRow & "A:AF" & LSearchRow).Copy
        'Select the sheet to paste on
        Select Case .Range("AG" & LSearchRow).Value
            Case Is = 1
                Set wsDest = Sheets("Green")
            Case Is = 2
                Set wsDest = Sheets("Blue")
            Case Is = 3
                Set wsDest = Sheets("Red")
            Case Else
                'Cover unknown cases
                MsgBox "Case not cover by code, press Ctrl+Break to stop code and debug", vbCritical + vbOKOnly
        End Select
        'Calculate first empty row on destination sheet
        LCopyToRow = wsDest.Range("A" & wsDest.Rows.Count).End(xlUp).Row + 1
        'Paste the copied row
        wsDest.Rows(LCopyToRow & "A:AF" & LCopyToRow).Paste
        'Continue to next line
        LSearchRow = LSearchRow + 1
    Wend
End With

End Sub

- R3uK

---

没有规定值必须是1、2或3。在无匹配项的情况下停止程序似乎过于极端。 - user4039065

@Jeeped：是的，有的，在代码的注释中看一下！ ;) OP完全可以对Msgbox行进行注释，这只是我在构建某些东西时处理未预定义情况的习惯。 - R3uK

@R3uK 很不幸，我仍然遇到了类型不匹配的错误。 - Dr. Steinberg

@LukaTauvae：好的，我的错，可能是由于没有使用CStr而使用了Len。如果问题已解决，请告诉我！;) - R3uK