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.