お客様リスト一覧
赤い枠は入力です。それ以外のところは全て関数を入れます。
下記の作り方を参照して作ってみましょう。
この例題は地区と担当を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関数も覚えられるよ
0コメント