Excel VBA工作代码今天突然出现“types不匹配”错误
下面的代码现在已经运行了6个月了，并没有改变（据我所知）。 今天我运行代码，并得到运行时错误13types不匹配。 得到错误的代码行由（TYPE MISMATCH ——–>）指出请帮忙。
Sub ADULTClearAndPaste() Dim lr As Long, lr2 As Long, r As Long Set Sh1 = ThisWorkbook.Worksheets("Members to cut & past") Set Sh2 = ThisWorkbook.Worksheets("ADULT Sign On Sheet") Program = 9 ATP = 10 FIFO = 7 LastName = 2 FirstName = 3 Sh2.Select For Each cell In Sh2.Range("B1:F756") If cell.Interior.Color = Excel.XlRgbColor.rgbWhite Then cell.ClearContents End If Next lr = Sh1.Cells(Rows.Count, "B").End(xlUp).Row W = 7 For r = 2 To lr TYPE MISMATCH --------> If Sh1.Range("U" & r).Value = "White" Then Sh2.Cells(W, 2).Value = Sh1.Cells(r, Program).Value Sh2.Cells(W, 3).Value = Sh1.Cells(r, ATP).Value Sh2.Cells(W, 4).Value = Sh1.Cells(r, FIFO).Value Sh2.Cells(W, 5).Value = Sh1.Cells(r, LastName).Value Sh2.Cells(W, 6).Value = Sh1.Cells(r, FirstName).Value W = W + 1 End If Next r 我的猜测是这个单元格在它的值中有一个错误，或者包含一个非string。 下面的代码应该可以消除你的错误：
Sub ADULTClearAndPaste() Dim lr As Long, lr2 As Long, r As Long Dim Sh1 as Worksheet, Sh2 as Worksheet Dim StrVal as String Dim Program as Integer, ATP as Integer, FIFO as Integer, LastName as Integer, FirstName as Integer Set Sh1 = ThisWorkbook.Worksheets("Members to cut & past") Set Sh2 = ThisWorkbook.Worksheets("ADULT Sign On Sheet") Program = 9 ATP = 10 FIFO = 7 LastName = 2 FirstName = 3 For Each cell In Sh2.Range("B1:F756") If cell.Interior.Color = Excel.XlRgbColor.rgbWhite Then cell.ClearContents End If Next lr = Sh1.Cells(Rows.Count, "B").End(xlUp).Row W = 7 For r = 2 To lr On Error Resume Next StrVal = vbNullString StrVal = Sh1.Range("U" & r).Value On Error GoTo 0 'Or implement proper error handling If StrVal = "White" Then Sh2.Cells(W, 2).Value = Sh1.Cells(r, Program).Value Sh2.Cells(W, 3).Value = Sh1.Cells(r, ATP).Value Sh2.Cells(W, 4).Value = Sh1.Cells(r, FIFO).Value Sh2.Cells(W, 5).Value = Sh1.Cells(r, LastName).Value Sh2.Cells(W, 6).Value = Sh1.Cells(r, FirstName).Value W = W + 1 End If Next r End Sub
上面的代码应该消除你的错误，但不会解决你的问题的根本原因。 下面的代码不仅会消除你的错误，而且还会显示任何错误行的消息框。
Sub ADULTClearAndPaste() Dim lr As Long, lr2 As Long, r As Long Dim Sh1 as Worksheet, Sh2 as Worksheet Dim StrVal as String, StrOutput as String Dim Program as Integer, ATP as Integer, FIFO as Integer, LastName as Integer, FirstName as Integer Set Sh1 = ThisWorkbook.Worksheets("Members to cut & past") Set Sh2 = ThisWorkbook.Worksheets("ADULT Sign On Sheet") Program = 9 ATP = 10 FIFO = 7 LastName = 2 FirstName = 3 For Each cell In Sh2.Range("B1:F756") If cell.Interior.Color = Excel.XlRgbColor.rgbWhite Then cell.ClearContents End If Next lr = Sh1.Cells(Rows.Count, "B").End(xlUp).Row W = 7 For r = 2 To lr On Error Resume Next If IsError(Sh1.Range("U" & r).Value) Then 'There is an error with the value. Log it for output. If StrOutput = vbNullString Then StrOutput = "Errors encountered with the following rows: " & r Else StrOutput = StrOutput & ", " & r End If Else 'Execute your code StrVal = vbNullString StrVal = Sh1.Range("U" & r).Value On Error GoTo 0 'Or implement proper error handling If StrVal = "White" Then Sh2.Cells(W, 2).Value = Sh1.Cells(r, Program).Value Sh2.Cells(W, 3).Value = Sh1.Cells(r, ATP).Value Sh2.Cells(W, 4).Value = Sh1.Cells(r, FIFO).Value Sh2.Cells(W, 5).Value = Sh1.Cells(r, LastName).Value Sh2.Cells(W, 6).Value = Sh1.Cells(r, FirstName).Value W = W + 1 End If End If Next r 'Display success or error message If StrOutput <> vbNullString Then MsgBox StrOutput, vbCritical Else MsgBox "Done!" End If End Sub
这是缺less表格名称的结尾“E”？
Set Sh1 = ThisWorkbook.Worksheets("Members to cut & past")
似乎是第一次尝试和使用工作表是错误的时候
编辑：我的坏，你在这里使用它没有错误：
lr = Sh1.Cells(Rows.Count, "B").End(xlUp).Row
你的代码适用于我，可能死参考？ 检查VBE中的工具/引用中的“缺失”。