以下代码已经运行了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
答案 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