如果列AG包含某个值,我尝试将整个行复制到名为“所有组”(从A到AF)的工作表上,并将其粘贴到名为“绿色”的工作表中(如果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
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语句可以很好地处理这种标准检查。实际复制仅需要单个单元格的目的地;其余的粘贴仅跟随它。
本文收集自互联网,转载请注明来源。
如有侵权,请联系 [email protected] 删除。
我来说两句