[英]vba Excel 2016: type mismatch error
I am trying to copy a entire row on a sheet named "All groups" (A to AF) if column AG contained a certain value and paste it into a sheet named "Green" (if AG =1, blue if AG=2 and Red if AG=3 ). 我试图在名为“所有组”(A到AF)的工作表上复制整行,如果列AG包含特定值并将其粘贴到名为“绿色”的工作表中(如果AG = 1,则蓝色,如果AG = 2且如果AG = 3,则为红色。
However, i get a type mismatch error . 但是,我收到类型不匹配错误 。
I have looked on the forum and the internet of posts of similar errors but i wasn't able to find an answer that would help me. 我看过论坛和互联网上有类似错误的帖子,但我找不到能帮到我的答案。 I am using Excel 2016 and Here is my code: 我正在使用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
You've gotten a little over-exuberant with the CStr number-to-text-that-looks-like-a-number conversions. CStr的数字到文本看起来像是一个数字转换,你已经有点过分了。 Numbers should be treated as numbers and text as text. 数字应被视为数字,文本应视为文本。 Cross-matching may or may not produce the desired results. 交叉匹配可能会或可能不会产生所需的结果。
I couldn't find where you were incrementing the LSearchRow
var so I've added that. 我找不到你在哪里增加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
This sort of criteria check is handled very well by a Select Case statement . Select Case语句可以很好地处理这种标准检查。 The actual copying only needs a destination of a single cell; 实际复制只需要一个单元的目的地; the rest of the paste just follows it. 其余的粘贴就跟着它了。
You don't need to use CStr
everywhere, VBA will implicitly convert the whole characters chain to a String as it is a concatenation (string addition) and that he expect to have a String argument. 你不需要在任何地方使用CStr
,VBA会隐式地将整个字符链转换为String,因为它是一个串联(字符串添加),并且他希望有一个String参数。
Further more, the .Select
is a really heavy method that is for the extreme majority of the cases absolutely useless, so I got rid of them! 更进一步, .Select
是一个非常重的方法,对于绝大多数情况绝对没用,所以我摆脱了它们!
I added Worksheet variable (notice the Set
keyword to assign value to an object), changed the If
s to a Select Case
and go everything that wasn't necessary inside of the If
. 我添加了Worksheet变量(注意Set
关键字为对象赋值),将If
s更改为Select Case
并将所有在If
不必要的内容更改。
Finally, I changed the calculation of the Paste row to be the first empty row in each sheet for each paste! 最后,我将Paste行的计算更改为每个工作表中每个工作表中的第一个空行!
This is your code a bit transformed but it decompose every step of the process, let me know if that work fine : 这是你的代码有点转变,但它分解过程的每一步,让我知道如果工作正常:
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
声明:本站的技术帖子网页,遵循CC BY-SA 4.0协议,如果您需要转载,请注明本站网址或者原文地址。任何问题请咨询:yoyou2525@163.com.