[英]VBA Vlookup slow and crashing
My VBA vlookup code is crashing excel, and takes forever to execute even though the file size is 519 KB. 我的VBA vlookup代码崩溃了,即使文件大小为519 KB,也要花很长时间才能执行。 I tried to switch it to a Index/Match, and still takes forever. 我试图将其切换为索引/匹配,但仍然需要花费很多时间。 Other modules work perfectly with no hussle. 其他模块完美运行,毫不费力。 I need the vba and not the formula in cell because i use the content of the vlookup cells in later countifs 我需要vba而不是单元格中的公式,因为我在以后的countifs中使用vlookup单元格的内容
Public Sub MatchRC()
Dim DCP_nbr As String
Dim Rootcause As String
Dim xrange As Range
Dim trange As Range
Dim x As Long
Dim hrange As Range
Dim here As String
Dim c As Range
lastRow = ActiveWorkbook.Sheets("Sheet1").Cells(Rows.Count, 1).End(xlUp).Row
'trange = ActiveWorkbook.Sheets("Sheet1").Range("J:K")
For x = 2 To lastRow
On Error Resume Next
If ActiveWorkbook.Sheets("Sheet1").Cells(x, 2).Value <> "" Then
'xrange = Range("x,B")
DCP_nbr = ActiveWorkbook.Sheets("Sheet1").Cells(x, 2).Value
here = Application.IfError(Application.WorksheetFunction.VLookup(DCP_nbr, ActiveWorkbook.Sheets("Sheet1").Range("J2:K2000"), 2, False), "Error")
'Range("x,G").Value = here
ActiveWorkbook.Sheets("Sheet1").Cells(x, 7).Value = here
Else
ActiveWorkbook.Sheets("Sheet1").Cells(x, 7).Value = "Error"
End If
Next x
End Sub
Perhaps like this instead? 也许像这样吗?
Sub tgr()
Dim ws As Worksheet
Set ws = ActiveWorkbook.Sheets("Sheet1")
With ws.Range("G2:G" & ws.Cells(ws.Rows.Count, "A").End(xlUp).Row)
If .Row < 2 Then Exit Sub 'No data
.Formula = "=IF(B" & .Row & "<>"""",IFERROR(VLOOKUP(B" & .Row & ",$J:$K,2,FALSE),""Error""),""Error"")"
.Value = .Value
End With
End Sub
summing up some of pieces of advice given in comments: 总结评论中给出的一些建议:
Public Sub MatchRC()
Dim DCP_nbr As String
Dim c As Range
Dim res As Variant, lookUpVals As Variant, retVals As Variant
With ActiveWorkbook.Sheets("Sheet1") ' reference your sheet once and for all
lookUpVals = .Range("J2:J2000").Value ' fill lookup array with referenced sheet range J2:J2000
retVals = .Range("K2:K2000").Value 'fill return values array with referenced sheet range K2:K2000
With .Range("B2", .Cells(.Rows.Count, 2).End(xlUp)) ' reference referenced sheet column B cells from row 2 down to last not empty one
For Each c In .SpecialCells(xlCellTypeConstants) ' loop through referenced range not empty values (assuming there will alwyas be at least two ...)
DCP_nbr = c.Value ' get current not empty value
res = Application.Match(DCP_nbr, lookUpVals) ' try searching current value in lookup array
If IsError(res) Then ' if not found
c.Offset(, 5) = "Error"
Else
c.Offset(, 5) = retVals(res, 1) ' write corresponding return values array item
End If
Next
If WorksheetFunction.CountBlank(.Cells) > 0 Then .SpecialCells(xlCellTypeBlanks).Offset(, 5) = "Error" ' place "Error" in column "G" cells corresponding to column "B" empty ones
End With
End With
End Sub
声明:本站的技术帖子网页,遵循CC BY-SA 4.0协议,如果您需要转载,请注明本站网址或者原文地址。任何问题请咨询:yoyou2525@163.com.