VBA講座　レッスン3　HLOOKUP関数

赤い枠は入力です。それ以外のところは全て関数を入れます。

下記の作り方を参照して作ってみましょう。

この例題は地区と担当をHLOOLUP(横向きLOOKUP関数)で作成します。

作り方

ではこの例題をVBAで実現します。

書き込んだ時に実行されるイベントプロシージャWorksheet_Changeを使います

例題をこの通りに再現して、下記のプログラムをコピーして、このプログラム一行ずつ実行して動作を確認して覚えましょう。

Private Sub Worksheet_Change(ByVal Target As Range)
   
    Dim nRow As Long
    Dim nCol As Long
    Dim Au() As Variant
   
    nRow = Target.Row
    nCol = Target.Column
       
    If nCol = 2 Then Call kaiin
    If nCol < 4 Or nCol = 5 Then Exit Sub
    If nCol > 6 Then Exit Sub
    If nRow < 9 Then Exit Sub
   
    If nCol = 6 Then Call Tikucoad(nRow, nCol)
    If nCol = 4 Then Call Nyuka(nRow, nCol)
       
End Sub
 
Private Sub Tikucoad(nRow As Long, nCol As Long)
   
    Dim Au() As Variant
       
    trgetmoji = Cells(nRow, nCol)
       
'縦VLOOKUP 地区コード　配列読み込み
    code_col = 10
    ws2End = Range("J" & 8).CurrentRegion.Rows.Count
   
    ReDim Au(2, ws2End)
   
    If Cells(nRow, nCol) <> "" Then
        s = 9
        For i = 1 To ws2End - 1
            Au(0, i) = Cells(s, code_col)
            Au(1, i) = Cells(s, code_col + 1)
            Au(2, i) = Cells(s, code_col + 2)
            s = s + 1
        Next
  
        Au(0, 0) = i - 1
        For j = 1 To Au(0, 0)
            If Cells(nRow, nCol) = Au(0, j) Then
           
                Application.EnableEvents = False
                Cells(nRow, nCol + 1) = Au(1, j)
                Cells(nRow, nCol + 2) = Au(2, j)
                Application.EnableEvents = True
               
                Exit Sub
            End If
        Next j
        MsgBox ("見つかりません")
    End If
 
End Sub
 
Private Sub Nyuka(nRow As Long, nCol As Long)
 
    today = Cells(6, 4)
    nyukaibi = Cells(nRow, nCol)
   
    Application.EnableEvents = False
    Cells(nRow, nCol + 1) = DateDiff("m", nyukaibi, today)
    Application.EnableEvents = True
       
End Sub
 
Private Sub Tukisu()
 
    Dim nyukaibi As Date
    Dim today As Date
    Dim tuki As Long
       
    y = 9
    Do While Cells(y, 1) <> ""
        today = Date
           
        If Cells(y, 4) <> "" Then
            nyukaibi = Cells(y, 4)
           
            Application.EnableEvents = False
            Cells(y, 5) = DateDiff("m", nyukaibi, today)
            Application.EnableEvents = True
 
        End If
       
        y = y + 1
       
        Application.EnableEvents = False
        Cells(6, 3) = y - 9
        Application.EnableEvents = True
       
    Loop
 
End Sub
 
Private Sub Worksheet_Activate()
 
    Tukisu
 
End Sub
 
Private Sub kaiin()
 
    wsEnd = Range("A8").CurrentRegion.Rows.Count
   
    Application.EnableEvents = False
    Range("C6") = wsEnd - 1
    Application.EnableEvents = True
       
End Sub

• ■ここで問題です。
• ■この縦向きを横向きHLOOKUPの方法でプログラミングしてください
• ■がんばってね( ^)o(^ )

Excel関数で計算、HLOOKUP関数も覚えられるよ

中級レッスン３　ダウンロードはこちら