マクロにVLOOKUPさせる

nyan.vb

Sub getValue()

Application.Calculation = xlManual   '再計算の停止'
Application.ScreenUpdating = False  '描画の停止'

     Dim Rng As Range
     Dim SerchArea As Range
     Dim Results As Variant

     'Function.VLookupの検索範囲の設定'
     MaxRow = Worksheets("Sheet2").Cells(Rows.Count, 1).End(xlUp).Row '縦'
     MaxCol = Worksheets("Sheet2").Cells(1, Columns.Count).End(xlToLeft).Column '横'

     Set Rng = Worksheets("Sheet2").Cells(MaxRow, MaxCol)
     Set SerchArea = Worksheets("Sheet2").Range("A2", Rng)

     '初期設定'
     Endrow = Worksheets("Sheet1").Cells(Rows.Count, 1).End(xlUp).Row
     Endcol = Worksheets("Sheet2").Cells(1, 1).End(xlToRight).Column
     Stpnt = Worksheets("Sheet1").Cells(3, 1).End(xlToRight).Column    'Resultsの初期挿入位置'
     Stpnt = Stpnt + 1

     r = 3
     b = 2

    If Endcol = 2 Then 'Sheet2の表のColumnが2列しか無い場合（主に前日の実績を入れる時）'

           For rowloop = 3 To Endrow Step 1
                 On Error Resume Next
                 asid = Worksheets("Sheet1").Cells(r, 1).Value
                 Results = Application.WorksheetFunction.VLookup(asid, SerchArea, b, False)

                 If Err <> 0 Then Results = 0
                 Worksheets("Sheet1").Cells(r, Stpnt).Value = Results
                 r = r + 1
           Next rowloop
    Else                        'Sheet2の表のColumnが3列以上（マスタ更新時の過去実績の取得や、連休中の実績をまとめて取得する時）'

           For colloop = 2 To Endcol Step 1
                On Error Resume Next

                        For rowloop = 3 To Endrow Step 1
                              asid = Worksheets("Sheet1").Cells(r, 1).Value
                              Results = Application.WorksheetFunction.VLookup(asid, SerchArea, b, False)

                              If Err <> 0 Then Results = 0
                              Worksheets("Sheet1").Cells(r, Stpnt).Value = Results
                              r = r + 1
                       Next rowloop

                Stpnt = Stpnt + 1
                b = b + 1
                r = 3
          Next colloop

    End If

     Set SerchArea = Nothing
     Set Rng = Nothing

MsgBox "処理が完了しました"

Application.Calculation = xlAutomatic '再計算の再開'
Application.ScreenUpdating = True     '描画の再開'

End Sub