お客様リスト

お客様リスト
赤い枠は入力です。それ以外のところは全て関数を入れます。
下記の作り方を参照して作ってみましょう。

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

この例題は地区と担当をVLOOLUP(縦向きLOOKUP関数)で作成します。実用的ですね。

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

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