VBAのVlookupの代わりに？

Question

VLookupを使用せずに、VBAを使用して列内の特定の参照を検索し、その行の別の列からデータを引き出すという別の方法があります。

私がデータを取得しようとしているテーブルには、数字、テキスト、日付が混在しており、ルックアップ値は13桁を超えることがよくあります。

私はある種のVLookupで作業していましたが、矛盾しすぎていました。データタイプが一致しなかったために頻繁に壊れてしまいました。 「タイプミスマッチ」や「ByRef」というエラーがひどくあります。私は1つ右に、次に別のブレークになります。

残念ながら、私は正しい方向に私を得るために何を検索するのか十分に知りません。

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 e.g. "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 

EDIT：いくつかの構文を修正し、それは私がやろうとしているかを説明できます場合は

は、ここではそのエラーのすべての時間を使用してVLOOKUP私のコードです。

Answer 1

カラムの場合は、範囲オブジェクトのFindメソッドを使用できます。戻り値は、一致がない場合を除いて、値が一致する最初のセルです。その後、Nothingが返されます。

戻り値の範囲では、同じ行のセルを返す場合は、EntireRowとを使用してセルを選択できます。

ところで、ワークブック関数のVLOOKUPのより柔軟な代替方法は、INDEXとMATCHの組み合わせです。

Answer 2

テストされていないが、コンパイル：

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

あなたは `strStatus`かを使用しようとする前に、あなたのコード

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 e.g. "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