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

Answer 1

CStr的數字到文本看起來像是一個數字轉換，你已經有點過分了。 數字應被視為數字，文本應視為文本。 交叉匹配可能會或可能不會產生所需的結果。

我找不到你在哪里增加LSearchRow var所以我已經添加了。

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語句可以很好地處理這種標准檢查。 實際復制只需要一個單元的目的地; 其余的粘貼就跟着它了。

Answer 2

你不需要在任何地方使用CStr ，VBA會隱式地將整個字符鏈轉換為String，因為它是一個串聯（字符串添加），並且他希望有一個String參數。

更進一步， .Select是一個非常重的方法，對於絕大多數情況絕對沒用，所以我擺脫了它們！

我添加了Worksheet變量（注意Set關鍵字為對象賦值），將If s更改為Select Case並將所有在If不必要的內容更改。

最后，我將Paste行的計算更改為每個工作表中每個工作表中的第一個空行！

這是你的代碼有點轉變，但它分解過程的每一步，讓我知道如果工作正常：

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