在VBA中替代Vlookup？

也许是一个奇怪的问题，但是有没有另一种方法来打开工作簿，search列中的特定引用，然后使用VBA从该行中的另一列中提取数据，而不使用VLookup？

我试图从中获取数据的表格包含数字，文本，date的组合，并且查找值通常长于13位数字。

我有一些与VLookup有一些工作，但它太不一致了 – 每隔一段时间，它会因为数据types不匹配而中断。 很多'types不匹配'或'ByRef'错误 – 我会得到一个正确的，然后再打破。

不幸的是我不知道该怎么search才能让我走向正确的方向。

如果它有助于解释我正在尝试做什么，这里是我的代码使用VLookup，始终是错误：

Sub getData() Application.EnableEvents = False Application.ScreenUpdating = False Application.DisplayAlerts = False Application.Calculation = xlManual Dim wb As Workbook, src As Workbook Dim srcRange As Range Dim InputString Dim strStatus Dim strStatusNum Dim strD1 Dim I As Integer Set wb = ActiveWorkbook I = 7 Set src = Workbooks.Open("D:\Files\test2.xlsx", True, True) With src.Sheets(1) Set srcRange = .Range(.Range("A1"), .Range("H1").End(xlDown)) End With Do While wb.ActiveSheet.Cells(I, 1) <> "" 'Makes sure src.Close is called if errors 'On Error Resume Next InputString = wb.Worksheets("Sheet 1").Cells(I, 1) strStatus = Application.VLookup(InputString, srcRange, 3, False) strD1 = Application.VLookup(InputString, srcRange, 4, False) 'Convert strStatus to actual number eg "03. no d1" strStatusNum = Left(strStatus, 2) wb.Worksheets("Sheet 1").Cells(I, 4) = strStatusNum If (strStatusNum <> 3) Then wb.Worksheets("Sheet 1").Cells(I, 2) = "Not at 03. No Work Order" ElseIf (strStatusNum = 3) And (strD1 <> "") Then wb.Worksheets("Sheet 1").Cells(I, 2) = "D1 Received" wb.Worksheets("Sheet 1").Cells(I, 3) = strD1 Else wb.Worksheets("Sheet 1").Cells(I, 2) = "No D1" End If I = I + 1 Loop src.Close (False) Application.EnableEvents = True Application.ScreenUpdating = True Application.DisplayAlerts = True Application.Calculation = xlAutomatic End Sub 

编辑：更正了一些语法。

Answer 1

您可以使用范围对象的Find方法，对于列的情况。 返回值是具有匹配值的第一个单元格，除非完全没有匹配。 然后Nothing返回。

在返回的范围内，您可以使用EntireRow和Cells来select要返回的同一行中单元格的列。

顺便说一下，在工作簿函数中更灵活的替代VLOOKUP是INDEX和MATCH的组合。

Answer 2

未经testing但编译：

 Sub getData() Dim src As Workbook Dim srcRange As Range Dim strStatus, strStatusNum, strD1 Dim m, rw As Range Set rw = ActiveSheet.Rows(7) Set src = Workbooks.Open("D:\Files\test2.xlsx", True, True) With src.Sheets(1) Set srcRange = .Range(.Range("A1"), .Range("H1").End(xlDown)) End With Do While rw.Cells(1).Value <> "" m = Application.Match(rw.Cells(1), srcRange.Columns(1), 0) If Not IsError(m) Then 'proceed only if got match strStatus = srcRange.Cells(m, 3).Value strD1 = srcRange.Cells(m, 4).Value strStatusNum = Left(strStatus, 2) rw.Cells(4).Value = strStatusNum If strStatusNum <> 3 Then rw.Cells(2) = "Not at 03. No Work Order" ElseIf strStatusNum = 3 And strD1 <> "" Then rw.Cells(2) = "D1 Received" rw.Cells(3) = strD1 Else rw.Cells(2) = "No D1" End If End If Set rw = rw.Offset(1, 0) Loop src.Close False End Sub 

Answer 3

你可能会在重构你的代码之后

 Sub getData() Dim wbRng As Range, cell As Range, f As Range Dim strStatus, strStatusNum, strD1 Application.EnableEvents = False Application.ScreenUpdating = False Application.DisplayAlerts = False Application.Calculation = xlManual With ActiveWorkbook.ActiveSheet Set wbRng = .Range("A7:A" & WorksheetFunction.Max(7, .Cells(.Rows.count, 1).End(xlUp).Row)) '<--| set the range of values to be searched for If WorksheetFunction.CountA(wbRng) = 0 Then Exit Sub '<--| exit if no values under row 7 Set wbRng = wbRng.SpecialCells(xlCellTypeConstants) '<--| narrow the range of values to be searched for down to not blank values only End With With Workbooks.Open("D:\Files\test2.xlsx", True, True).Sheets(1) '<--| open wanted workbook and reference its first sheet With .Range("A1:A" & .Cells(.Rows.count, "H").End(xlUp).Row) '<--| reference its column A range from row 1 down to column H last not empty cell (this is your former "srcRange") For Each cell In wbRng.SpecialCells(xlCellTypeConstants) '<--| loop through range of values to be searched for Set f = .Find(what:=cell.Value, lookat:=xlWhole, LookIn:=xlValues) '<--| look referenced range for current value to be searched for If Not f Is Nothing Then '<--| if found strStatus = f.Offset(, 2).Value strD1 = f.Offset(, 3).Value 'Convert strStatus to actual number eg "03. no d1" strStatusNum = val(Left(strStatus, 2)) '<--| use 'Val()' function to convert string "03" to "3" cell.Offset(, 3) = strStatusNum Select Case True Case strStatusNum <> 3 cell.Offset(, 1).Value = "Not at 03. No Work Order" Case strStatusNum = 3 And (strD1 <> "") cell.Offset(, 1).Resize(, 2).Value = Array("D1 Received", strD1) Case Else cell.Offset(, 1).Value = "No D1" End Select End If Next End With .Parent.Close False End With Application.EnableEvents = True Application.ScreenUpdating = True Application.DisplayAlerts = True Application.Calculation = xlAutomatic End Sub