VBA経費管理4　(Worksheet_SelectionChange2)

Worksheet_SelectChange1では以下に示した、いくつかのプロジャーの呼出がありました。

Clr_01、CalenderA 、kamokuA、 TextA (str) 、 TextB (str)、 TekiyouA (str)、Call TextName

について解説します。また、セルの位置はVBA経費管理1 (Workbookの構成)に基づいて作成しています。

Clr_01は入力欄、申請日、伝票番号、入力候補リスト欄をクリアするプロジャーです。
Worksheet_SelectChange以外でも利用されるため、Moduleに記述しています。詳細はModuleで解説します。

CalenderA
kamokuA
TextA(str)
TextB(str)
TekiyouA(str)
TextName
ClrListA()

CalenderA

Sub CalenderA()

ClrListA　‘入力候補欄クリア

Cells(5, 1).Value = “日付”
Cells(5, 2).Value = “曜日”
Cells(5, 3).Value = “”

For h = 0 To 30
　Cells(7 + h, 2).Value = WeekdayName(Weekday(DateAdd(“d”, -h, Date)), True)
　Cells(7 + h, 1).Value = Mid(DateAdd(“d”, -h, Date), 1, 4) & Mid(DateAdd(“d”, -h, Date), 6, 2) & Mid(DateAdd(“d”, -h, Date), 9, 2)
Next

End Sub

後述する、ClrListAで入力候補欄(“A6:C100”)をクリアします。

入力候補項目としてA5セルに“日付”、B5セルに“曜日”を代入します。

Worksheet_SelectChangeで、F6セルが選択されたとき、今日を起点とするカレンダーが、入力候補欄に表示されます。

B列にWeekdayName(Weekday(DateAdd(“d”, -h, Date)), True)を利用して曜日を表示。

A列にFor Next とDateAddとMid()を利用して、過去30日分、“yyyymmdd”形式で日付を表示しています。

kamokuA

Sub kamokuA()

ClrListA　‘入力候補欄クリア

Cells(5, 1).Value = “勘定科目”
Cells(5, 2).Value = “摘要”
Cells(5, 3).Value = “区分”

Set DTH1 = Worksheets(“費用区分”).Range(“A1”).CurrentRegion
f = DTH1.Rows.Count

For h = 2 To f
　Cells(h + 5, 2).Value = DTH1.Cells(h, 1).Value
　Cells(h + 5, 1).Value = DTH1.Cells(h, 2).Value
　Cells(h + 5, 3).Value = DTH1.Cells(h, 3).Value
Next

End Sub

ClrListAで入力候補欄をクリアします。

入力候補欄の項目として、A5セルに“勘定科目”、B5セルに“摘要”、C5セルに“区分”を代入します。

ワークシート“費用区分”からデータ行数を取得して、すべて入力候補欄にデータを転記します。

TextA(str)

Private Sub TextA(str)

ClrListA

‘選択リストの項目取得
Select Case Cells(6, 7).Value
Case “旅費交通費”
　Cells(5, 1).Value = “訪問先”
　Cells(5, 2).Value = “”
　Cells(5, 3).Value = “”
Case Else
　Cells(5, 1).Value = “支払先”
　Cells(5, 2).Value = “”
　Cells(5, 3).Value = “”
End Select

Dim DTH1 As Range
Set DTH1 = Worksheets(“経費実績”).Range(“A1”).CurrentRegion
f = DTH1.Rows.Count

str2 = “”
k = 7

‘選択リスト作成
For i = 2 To f
If DTH1.Cells(i, 4).Value = str Then ‘申請区分
　If Not str2 Like “*” & DTH1.Cells(i, 5).Value & “*” Then ‘Text1
　　Cells(k, 1).Value = DTH1.Cells(i, 5).Value
　　str2 = str2 + DTH1.Cells(i, 5).Value
　　k = k + 1
　　If k >= 100 Then Exit Sub
　End If
End If
Next

End Sub

TextA(str)では、これまで記録された”経費実績”から、入力候補欄にText1（5列目）を取得します。

ClrListAで入力候補欄をクリアします。

入力候補欄の項目として、G6セルが” 旅費交通費”であった場合にA5セルに“訪問先”、G6セルが” 旅費交通費”以外であれば、A5セルに“支払先”を代入しています。

ワークシート”経費実績”の4列目の値が、strに代入された文字と同じであれば、5列目のテキストを取得して入力候補欄に転記します。

取得した5列目のテキストは（str2 = str2 + DTH1.Cells(i, 5).Value） でstr2に貯められ、（If Not str2 Like “*” & DTH1.Cells(i, 5).Value & “*” Then）で重複を避けています。

リストに転記された場合、k = k + 1で加算して、k = 100　でFor Nextを抜けます。

100はリスト表示させる件数を制限するもので、適当な値を設定してください。

TextB(str)

Private Sub TextB(str)

ClrListA

‘選択リストの項目取得
Select Case Cells(6, 7).Value
Case “旅費交通費”
　Cells(5, 1).Value = “区間”
　Cells(5, 2).Value = “金額”
　Cells(5, 3).Value = “”
Case “現金”, “仮払金”
　Cells(5, 1).Value = “Text1”
　Cells(5, 2).Value = “”
　Cells(5, 3).Value = “”
Case Else
　Cells(5, 1).Value = “支払先”
　Cells(5, 2).Value = “金額”
　Cells(5, 3).Value = “”
End Select

Dim DTH1 As Range
Set DTH1 = Worksheets(“経費実績”).Range(“A1”).CurrentRegion
f = DTH1.Rows.Count

str2 = “”
k = 7

‘選択リスト作成
For i = f To 2 Step -1
　If DTH1.Cells(i, 5).Value = str Then ‘Text1
　　If DTH1.Cells(i, 6).Value <> “” Then ‘Text1
　　　If Not str2 Like “*” & DTH1.Cells(i, 6).Value & “*” Then ‘Text1
　　　　Cells(k, 1).Value = DTH1.Cells(i, 6).Value
　　　　Cells(k, 2).Value = DTH1.Cells(i, 14).Value
　　　　k = k + 1
　　　　If k >= 100 Then Exit Sub
　　　　str2 = str2 + DTH1.Cells(i, 6).Value
　　　End If
　　End If
　End If
Next

End Sub

TextB(str)では、これまで記録された”経費実績”から、入力候補欄にText2（6列目）を取得します。

ClrListAで入力候補欄をクリアします。

入力候補欄の項目として、G6セルの値によって、入力候補項目、A5セル、B5セルにテキストを代入しています。

ワークシート”経費実績”の5列目の値が、strに代入された文字と同じであり、6列目の値が空白でないとき、6列目のテキストと14列目の金額を取得して入力候補欄に転記します。

一度取得した6列目のテキストは（str2 = str2 + DTH1.Cells(i, 5).Value） でstr2に貯められ、（If Not str2 Like “*” & DTH1.Cells(i, 5).Value & “*” Then）で重複を避けています。

TekiyouA(str)

Sub TekiyouA(str)

ClrListA

Cells(5, 1).Value = “摘要”
Cells(5, 2).Value = “”
Cells(5, 3).Value = “”

Set DTH1 = Worksheets(“経費実績”).Range(“A1”).CurrentRegion
f = DTH1.Rows.Count

str2 = “”
k = 7
For h = 2 To f
　If DTH1.Cells(h, 6).Value = str Then
　　If Not str2 Like “*” & DTH1.Cells(h, 8).Value & “*” Then
　　　Cells(k, 1).Value = DTH1.Cells(h, 8).Value
　　　Cells(k, 2).Value = DTH1.Cells(h, 15).Value
　　　str2 = str2 + DTH1.Cells(h, 8).Value
　　　k = k + 1
　　　If k >= 100 Then Exit Sub
　　End If
　End If
Next

End Sub

TekiyouA(str)では、これまで記録された”経費実績”から、入力候補欄にText2（6列目）を取得します。

ClrListAで入力候補欄をクリアします。

入力候補欄の項目として、G6セルの値によって、入力候補項目、A5セル、B5セルにテキストを代入しています。

ワークシート”経費実績”の6列目の値が、strに代入された文字と同じであれば、8列目のテキストと15列目の金額を取得して入力候補欄に転記します。

TextName

Sub TextName(ByVal str As String, ByVal str2 As String)

‘入力欄項目
Select Case str
Case “旅費交通費”
　Cells(5, 8) = “訪問先”　‘セル”H5”
　Cells(5, 9) = “区間” 　‘セル”I5”
Case Else
　Cells(5, 8) = “支払先”　‘セル”H5”
　Cells(5, 9) = “Text2” 　‘セル”I5”
End Select

Select Case str2
Case “出張手当”
　Cells(5, 8) = “訪問先”　‘セル”H5”
　Cells(5, 9) = “時間” 　‘セル”I5”
Case “小口現金引出”, “仮払金（受）”, “清算（受）”
　Cells(5, 8) = “支払元”　‘セル”H5”
　Cells(5, 9) = “Text2” 　‘セル”I5”
Case Else
End Select

End Sub

TextNameはWorksheet_SelectChange1で、頭にCallを付けて使用しています。
２つの引数を利用するときに、Call TextName(str,str2)の形で利用されます。（）を付けなければ、Callを省略することも出来ます。TextName　str,str2
TextNameは、メインのフレームWorksheet_SelectionChangeで、str,str2にセルの値をし、Select文でstr,str2の値を判定して、処理を振り分けます。

Select Case strではstr（選択したセルのB列）の値が“旅費交通費”である場合と、それ以外で処理を分けます。

この処理は入力候補欄の項目を変更する処理です。

これはIf文で書き換えることも容易です。
If str = “旅費交通費” Then
Cells(5, 8) = “訪問先”
Cells(5, 9) = “区間”
Else
Cells(5, 8) = “支払先”
Cells(5, 9) = “Text2”
End If

Select Case str2ではstr2（選択したセルA列）の値が“出張手当”である場合、あるいは“小口現金引出”, “仮払金（受）”, “清算（受）”である場合と、それ以外で処理を分けます。

この処理は、上記のSelect Case strで変更した入力候補欄の項目を、再度変更する処理です。

ClrListA()

Sub ClrListA()

‘入力候補欄クリア

ActiveSheet.Range(“A6:C100”).Select
Selection.ClearContents

‘Range(“A5”).Select

End Sub

入力候補欄クリア処理をClrListAとして、各プロジャーから呼び出して使用しています。

以上でWorksheet_SelectChange2は終わりです。