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

时间:2016-03-02 03:45:32

标签: excel vba excel-vba type-mismatch

以下代码已经运行了6个月,并且没有被更改(据我所知)。今天我运行代码并获得运行时错误13类型不匹配。获取错误的代码行由指出 (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

2 个答案:

答案 0 :(得分:0)

这是不是" e"在工作表名称的末尾?

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

似乎是第一次尝试使用工作表时出现错误

编辑:我的不好,你在这里使用它没有错误:

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

你的代码对我有用,可能是死的参考?检查"缺失"在VBE中的工具/参考文献中。

答案 1 :(得分:0)

我的猜测是单元格的值有误差或包含非字符串。以下代码应该消除您的错误:

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