简体   繁体   中英

Excel VBA Run-time error '13' Type mismatch8

I have done a "copy and paste" to a value after comparing the "road" number and the code number. If those two are matching, Excel VBA will copy and paste in a cell defined. I have created a loop to repeat it. But I discovered that up to 7000 my program was working properly, and when I replaced 7000 by 30000, Excel VBA displays

"Run-time error '13' Type mismatch "

after a certain time. I dont know why. Below is my program:

Private Sub assigment()
Dim road   As Double
Dim code As Double
Dim i  As Double

For i = 4 To 30000
   For code = 2 To 22
    For road = 4 To 65
       If ActiveWorkbook.Sheets("assignment").Cells(i,  6)=ActiveWorkbook.Sheets("SSUSE").Cells(3, code) Then
          If ActiveWorkbook.Sheets("assignment").Cells(i, 8) = ActiveWorkbook.Sheets("SSUSE").Cells(road, 1) Then
              ActiveWorkbook.Sheets("SSUSE").Cells(road, code).Copy ActiveSheet.Paste Destination:=ActiveWorkbook.Sheets("assignment").Cells(i, 10) 
         End If
       End If
    Next
   Next
Next
End Sub
Dim vSource as Variant, vCode as Variant, vRoad as Variant, vAssignment as Variant, vAddress as Variant

vSource = ActiveWorkbook.Sheets("assignment").Range("F4:F30000").Value
vCode = ActiveWorkbook.Sheets("SSUSE").Range("B3:V3").Value
vRoad = ActiveWorkbook.Sheets("SSUSE").Range("A4:A65").Value
vAddress = ActiveWorkbook.Sheets("SSUSE").Range("B4:V65").Value
vAssignment = ActiveWorkbook.Sheets("assignment").Range("H4:H30000").Value

For i = LBound(vSource,1) to UBound(vSource,1)
    For code = LBound(vCode,2) to UBound(vCode,2)
        For road = LBound(vRoad,1) to UBound(vRoad,1)
            If (vSource(i,1) = vCode(1, code)) AND (vAssignment(i,1) = vRoad(road,1)) Then
                ActiveWorkbook.Sheets("assignment").Cells(i+3, 10).Value = vAddress(Road,Code)
            End If
        Next
    Next
Next

The technical post webpages of this site follow the CC BY-SA 4.0 protocol. If you need to reprint, please indicate the site URL or the original address.Any question please contact:yoyou2525@163.com.

 
粤ICP备18138465号  © 2020-2024 STACKOOM.COM