Excel VBA工作代码突然出现了；“类型不匹配”；今天的错误

下面的代码已经完美地运行了6个月了，并且（据我所知）没有被修改。今天我运行代码，得到运行时错误13类型不匹配。获取错误的代码行由 （类型不匹配---------------->） 请帮忙

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

图纸名称末尾是否缺少一个“e”

Set Sh1 = ThisWorkbook.Worksheets("Members to cut & past")

似乎是这样的，你第一次尝试使用工作表是当它出错的时候

编辑：我的错，你在这里使用它没有错误：

lr = Sh1.Cells(Rows.Count, "B").End(xlUp).Row

你的代码对我有用，可能是死参考？检查VBE中的工具/参考中是否有“缺失”。

图纸名称末尾是否缺少一个“e”

Set Sh1 = ThisWorkbook.Worksheets("Members to cut & past")

似乎是这样的，你第一次尝试使用工作表是当它出错的时候

编辑：我的错，你在这里使用它没有错误：

lr = Sh1.Cells(Rows.Count, "B").End(xlUp).Row

---

你的代码对我有用，可能是死参考？检查VBE中的工具/引用是否“缺少”。

我的猜测是单元格的值中有错误或包含非字符串。以下代码将消除您的错误：

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

Sub-ADULTClearAndPaste（）
变暗lr等长，lr2等长，r等长
尺寸Sh1作为工作表，Sh2作为工作表
Dim StrVal作为字符串，StrOutput作为字符串
Dim程序为整数，ATP为整数，FIFO为整数，LastName为整数，FirstName为整数
Set Sh1=ThisWorkbook.worksheet（“要剪切和通过的成员”）
Set Sh2=此工作簿。工作表（“成人签到表”）
程序=9
ATP=10
先进先出=7
LastName=2
名字=3
对于Sh2.范围内的每个单元格（“B1:F756”）
如果cell.Interior.Color=Excel.XlRgbColor.rgbWhite，则
cell.ClearContents
如果结束
下一个
lr=Sh1.Cells（Rows.Count，“B”）.End（xlUp）.Row
W=7
对于r=2至lr
出错时继续下一步
如果IsError（Sh1.Range（“U”&r）.Value）那么
'该值存在错误。记录输出。
如果StrOutput=vbNullString，则
StrOutput=“以下行遇到错误：”&r
其他的
StrOutput=StrOutput&“，”&r
如果结束
其他的
'执行您的代码
StrVal=vbNullString
StrVal=Sh1.范围（“U”&r）.值
错误时转到“0”或执行正确的错误处理
如果StrVal=“白色”，则
Sh2.Cells（W，2）.Value=Sh1.Cells（r，Program）.Value
Sh2.细胞（W，3）.值=Sh1.细胞（r，ATP）.值
Sh2.单元（W，4）.Value=Sh1.单元（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
如果结束
如果结束
下一个r
'显示成功或错误消息
如果StrOutput vbNullString，则
MsgBox输出，vbCritical
其他的
MsgBox“完成！”
如果结束
端接头

我猜单元格的值中有错误或包含非字符串。以下代码将消除您的错误：

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

Sub-ADULTClearAndPaste（）
变暗lr等长，lr2等长，r等长
尺寸Sh1作为工作表，Sh2作为工作表
Dim StrVal作为字符串，StrOutput作为字符串
Dim程序为整数，ATP为整数，FIFO为整数，LastName为整数，FirstName为整数
Set Sh1=ThisWorkbook.worksheet（“要剪切和通过的成员”）
Set Sh2=此工作簿。工作表（“成人签到表”）
程序=9
ATP=10
先进先出=7
LastName=2
名字=3
对于Sh2.范围内的每个单元格（“B1:F756”）
如果cell.Interior.Color=Excel.XlRgbColor.rgbWhite，则
cell.ClearContents
如果结束
下一个
lr=Sh1.Cells（Rows.Count，“B”）.End（xlUp）.Row
W=7
对于r=2至lr
出错时继续下一步
如果IsError（Sh1.Range（“U”&r）.Value）那么
'该值存在错误。记录输出。
如果StrOutput=vbNullString，则
StrOutput=“以下行遇到错误：”&r
其他的
StrOutput=StrOutput&“，”&r
如果结束
其他的
'执行您的代码
StrVal=vbNullString
StrVal=Sh1.范围（“U”&r）.值
错误时转到“0”或执行正确的错误处理
如果StrVal=“白色”，则
Sh2.Cells（W，2）.Value=Sh1.Cells（r，Program）.Value
Sh2.细胞（W，3）.值=Sh1.细胞（r，ATP）.值
Sh2.单元（W，4）.Value=Sh1.单元（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
如果结束
如果结束
下一个r
'显示成功或错误消息
如果StrOutput vbNullString，则
MsgBox输出，vbCritical
其他的
MsgBox“完成！”
如果结束
端接头

检查U列中是否有错误的单元格。已检查，并检查了单元格的格式。抛出错误时的值或r是多少？当时该单元格的值是多少？@NickPeranzi第376行有一个值，这与我的vlookup不匹配。谢谢你，很乐意帮忙！检查U列中是否有错误的单元格。已检查，并检查单元格的格式。引发错误时，值或r是多少？当时该单元格的值是多少？@NickPeranzi第376行有一个值，这与我的vlookup不匹配。谢谢你，很乐意帮忙！感谢@DanDonoghue-我最近遇到了一个问题，其他变量类型在尝试加载空白值时抛出错误，我对此感到困惑。我去掉了它是空的这一点；不管怎样，我仍然相信OP的问题会通过我的回答得到解决。要想知道问题到底是什么，至少你的错误日志会显示行以便分析：）。边不