vba Excel 2016:键入不匹配错误

如果列AG包含一个特定的值,并且将其粘贴到名为“绿色”(如果AG = 1,AG = 2时为蓝色),并且将其粘贴到名为“所有组”红色如果AG = 3)。

但是,我得到一个types不匹配的错误

我看了论坛和类似错误的post的互联网,但我无法find一个答案,可以帮助我。 我正在使用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 

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语句处理得很好。 实际的复制只需要一个单元的目的地; 其余的粘贴就跟着它。

你不需要在任何地方使用CStr ,VBA会隐式地将整个字符链转换为一个string,因为它是一个串联(string加法),他期望有一个String参数。

此外, .Select是一个非常沉重的方法,绝大多数情况下是绝对无用的,所以我摆脱了他们!

我添加了Worksheetvariables(注意Set关键字将值赋给一个对象),把If改为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