みなさん、こんにちはケンケンです。
今回は、前回同様、売掛金集計表をカスタマイズしていきます。
みなさん、こんにちはケンケンです。 今回は、前回に引き続き売掛金管理についてお話ししていきます。 前回は集計表の入金欄が埋まっていない箇所に色を付けて警告を出す、という技をご紹介しました。 [sitec[…]
カスタマイズの内容は、得意先ごとに年間の取引状況を集計する、というものです。
先にイメージをお伝えすると以下のようになります。
集計したい得意先を選択してボタンを押すと、選択された得意先の一覧表が作成されます。
その際に、得意先の情報を一部載せます。（会社名、電話番号、所在地）
これが完成すると、得意先ごとの取引状況を視覚的に判断することが可能になり、かつ得意先との取引照合のツールとしても使うことができます。
それでは、作成してみましょう。
得意先ごとのリストと書式を用意しよう
まず最初に得意先ごとのリストを作ってしまいましょう。
今回は、以下のように用意しました。
※所在地や電話番号は架空のものを使用していますが、万が一該当するものがありましたらご容赦ください。
上記のようなリストを使います。
それと、冒頭でもお見せしたような得意先ごとの書式を用意します。シート名は「会社書式(元)」としました。
最終的にファイルの構成は以下のようになります。
- 売掛金集計表
- 会社リスト
- 会社書式(元)
- 集計
それでは、実際に得意先ごとの集計する仕組みを作り上げていきましょう。
書式をコピーして名前を変更しよう
まずは、会社書式(元)シートをコピーしてシート名を変更してみましょう。
売掛金集計表の下部に検索枠を設けて、以下のコードを標準モジュールに記述します。
Sub tokuisakibetu_syukei()
Dim uriS As Worksheet
Set uriS = Worksheets("売掛金集計表")
Dim Lrow
Lrow = uriS.Range("B" & Rows.Count).End(xlUp).Row
Sheets("会社書式(元)").Copy after:=Sheets(Sheets.Count)
ActiveSheet.Name = uriS.Range("B" & Lrow).Value
ActiveSheet.Range("B2").Value = uriS.Range("B" & Lrow).Value
End Sub
実行して、書式がコピーされてシート名が変更されるのと、B2セルに会社名が記載されていることを確認してください。
ちなみに、最終行をB列から引っ張ってきていますが、売掛金集計表上に検索機能をつけるため、B列の最終行は変動することを想定しているので、常に最終行を取得する形式にしました。
別シートに仕掛けを作る際は、セル番地固定で問題ありません。
会社リストを検索して書式に転記してみよう
続いて、コピーした書式に会社リストから該当する得意先の情報を抜き出して転記します。
まずは、直接転記する方法でコードを書いていきます。
先ほどのプロシージャと分けて新しいプロシージャを作ってそこに書きます。
Sub tokuisaki_kensaku()
Dim tokuisakiS As Worksheet
Set tokuisakiS = Worksheets("会社リスト")
ActiveSheet.Range("B3").Value = tokuisakiS.Range("C15").Value
ActiveSheet.Range("F2").Value = tokuisakiS.Range("D15").Value
End Sub
上記のコードをN株式会社のシート上で実行すると以下のように会社情報が転記されますね。
転記することは出来ましたが、このままでは、どの得意先情報を転記するにも常にN株式会社の情報を転記してしまいます。
そこで、条件を追加します。
条件は、検索元の会社名と会社リストの会社名が合致しているか否かを判定する、というものです、
Sub tokuisaki_kensaku()
Dim tokuisakiS As Worksheet
Set tokuisakiS = Worksheets("会社リスト")
Dim uriS As Worksheet
Set uriS = Worksheets("売掛金集計表")
Dim Lrow
Lrow = uriS.Range("B" & Rows.Count).End(xlUp).Row
Dim tokuiSaki
tokuiSaki = uriS.Range("B" & Lrow).Value
If tokuisakiS.Range("B15").Value = tokuiSaki Then
ActiveSheet.Range("B3").Value = tokuisakiS.Range("C15").Value
ActiveSheet.Range("F2").Value = tokuisakiS.Range("D15").Value
End If
End Sub
変数LRowで売掛金集計表のB列最終行を取得して、さらにその変数を使って変数tokuiSakiに売掛金集計表のB列最終行の値を代入します。
今回は、N株式会社になりますね。
そして、If文で会社リストシートのB１５セルと変数tokuiSakiに格納されている文字列を比較して同じだったら、If文の中を実行します。
上記の場合は、条件がマッチするのでIf文は実行されます。
次は、会社リストの得意先名をループさせる仕組みが必要です。
先ほどは会社リストのB15セル限定で検索しましたが、通常はB列全体を検索しなければ意味がありません。
そこでさらにコードを追加して、
Sub tokuisaki_kensaku()
Dim tokuisakiS As Worksheet
Set tokuisakiS = Worksheets("会社リスト")
Dim uriS As Worksheet
Set uriS = Worksheets("売掛金集計表")
Dim Lrow
Lrow = uriS.Range("B" & Rows.Count).End(xlUp).Row
Dim tokuiSaki
tokuiSaki = uriS.Range("B" & Lrow).Value
Dim kaisyalistLrow '会社リストシートの最終行取得
kaisyalistLrow = tokuisakiS.Range("A" & Rows.Count).End(xlUp).Row
Dim tokuiSakicnt '検索元データと会社リストシートを照合
For tokuiSakicnt = 2 To kaisyalistLrow
If tokuisakiS.Range("B" & tokuiSakicnt).Value = tokuiSaki Then
ActiveSheet.Range("B3").Value = tokuisakiS.Range("C" & tokuiSakicnt).Value
ActiveSheet.Range("F2").Value = tokuisakiS.Range("D" & tokuiSakicnt).Value
End If
Next
End Sub
上記のようにします。
会社リストシートの最終行を取得する変数kaisyalistLrowを宣言し、会社リストシートをループさせる変数tokuiSakicntも用意します。
このコードを実行すると、どの得意先を選択しても会社リストに記載されている得意先の情報が自動で入力されます。
ここでひとつテクニックをご紹介します。
今回は、プロシージャを２つに分けていましたね。２つに分ける理由は、コードを見やすくし、無駄な混乱を避けるためです。
しかし、分けたプロシージャを連続で起動させたいときもあります。
そこで、VBAでは分けたプロシージャをまとめて実行できる方法があります。
それが、「Call＋プロシージャ名」です。
Sub create_tokuisaki()
Call tokuisakibetu_syukei
Call tokuisaki_kensaku
End Sub
このように、起動させたい順にプロシージャ名を列挙することによって、プロシージャをまとめて起動させることができます。
便利なので使ってみてください。
売掛金集計表から書式に転記してみよう
それでは戻って続きを作ってみましょう。
得意先の電話番号と所在地を転記できたので、いよいよ売上データの転記をしましょう。
新しいプロシージャを作ります。
まず、売掛金集計表の得意先（A列）と検索値（B列最終行）の値が合致する行を探さなくてはなりません。
Sub tokuisaki_tenki()
Dim uriS As Worksheet
Set uriS = Worksheets("売掛金集計表")
Dim Lrow 'D列最終行を取得
Lrow = uriS.Range("D" & Rows.Count).End(xlUp).Row
Dim Lrow2 'B列最終行を取得
Lrow2 = uriS.Range("B" & Rows.Count).End(xlUp).Row
Dim tenkimotoGyo '検索先の得意先が格納されている行を取得
Dim kensakuC
tenkimotoGyo = 0
For kensakuC = 3 To Lrow
If uriS.Range("A" & kensakuC).Value = uriS.Range("B" & Lrow2).Value Then
tenkimotoGyo = kensakuC
Exit For
End If
Next
Range("A30").Value = tenkimotoGyo
End Sub
新しく作ったプロシージャに上記のようにコードを書いて実行してください。
A30セルに数字が入れば成功です。
この数字は、検索したい得意先、今回は「C株式会社」がA列の何行目にあるか探してその行数を転記しています。
F8を使ったステップインモードでひとつずつ検証してみてください。
新しい概念として、ExitForという部分がありますが、これはExitForを通過したらForNext構文から抜けるように指示するものです。
検索したい値「C株式会社」はひとつしかないはずなので、検索終了したらForNextから抜ける方が効率が良いのです。
さて、C株式会社の行数を取得できたので、その値を元に各月のデータを転記していきましょう。
まず最初に、４月分だけ転記します。コードは以下の通りです。
Sub tokuisaki_tenki()
Dim uriS As Worksheet
Set uriS = Worksheets("売掛金集計表")
Dim Lrow 'D列最終行を取得
Lrow = uriS.Range("D" & Rows.Count).End(xlUp).Row
Dim Lrow2 'B列最終行を取得
Lrow2 = uriS.Range("B" & Rows.Count).End(xlUp).Row
Dim tenkimotoGyo '検索先の得意先が格納されている行を取得
Dim kensakuC
tenkimotoGyo = 0
For kensakuC = 3 To Lrow
If uriS.Range("A" & kensakuC).Value = uriS.Range("B" & Lrow2).Value Then
tenkimotoGyo = kensakuC
Exit For
End If
Next
Worksheets(Worksheets.Count).Range("C5").Value = uriS.Cells(tenkimotoGyo, 4)
Worksheets(Worksheets.Count).Range("D5").Value = uriS.Cells(tenkimotoGyo, 5)
Worksheets(Worksheets.Count).Range("E5").Value = uriS.Cells(tenkimotoGyo, 6)
Worksheets(Worksheets.Count).Range("F5").Value = uriS.Cells(tenkimotoGyo, 7)
End Sub
最後の４行を追加しました。
そのうちの１行を解説しますと
Worksheets(Worksheets.Count).Range(“C5”).Value = uriS.Cells(tenkimotoGyo, 4)
転記先のシートはファイルの最後尾に作られているのでWorksheets(Worksheets.Count)で指定します。
転記先シートのC5の値を売掛金集計表のセルD5（Cells(tenkimotoGyo, 4)）の値にします。
Cells(tenkimotoGyo, 4)のtenkimotoGyoには「５」が入っていましたね。
上記コードを実行すると
４月分の転記に成功しました。
次は、これを３月までループさせてみます。
上記赤枠の部分を変更してみましょう。
転記先シートを５行目から１６行目（４月から３月）までをループさせます。
すると、
３月までデータが入りましたが、内容が重複していますね。
この現象は、転記元のデータを４月分しか取得していないため起こります。
そこで、転記元のデータもループさせるようにコードを書きかえてみましょう。
上記のようにコードを変更して再度実行してみてましょう。
あれっ？
また同じ結果になってしまいましたね。
これは、なんでかと言うと、新しく設定した変数の値に変化をつけていないことが原因です。
具体的には、ForNext構文が一回転した後に変数tenkimotoRetuに５（列分）プラスしなくてはなりません。
どうして５プラスのかは売掛金集計表を見ればわかります。
毎月の各データは５列分あるので変数に５プラスして次のループに備えなくてはならないのです。
Sub tokuisaki_tenki()
Dim uriS As Worksheet
Set uriS = Worksheets("売掛金集計表")
Dim Lrow 'D列最終行を取得
Lrow = uriS.Range("D" & Rows.Count).End(xlUp).Row
Dim Lrow2 'B列最終行を取得
Lrow2 = uriS.Range("B" & Rows.Count).End(xlUp).Row
Dim tenkimotoGyo '検索先の得意先が格納されている行を取得
Dim kensakuC
tenkimotoGyo = 0
For kensakuC = 3 To Lrow
If uriS.Range("A" & kensakuC).Value = uriS.Range("B" & Lrow2).Value Then
tenkimotoGyo = kensakuC
Exit For
End If
Next
Dim tenkiSaki
Dim tenkimotoRetu
tenkimotoRetu = 4
For tenkiSaki = 5 To 16
Worksheets(Worksheets.Count).Range("C" & tenkiSaki).Value = uriS.Cells(tenkimotoGyo, tenkimotoRetu)
Worksheets(Worksheets.Count).Range("D" & tenkiSaki).Value = uriS.Cells(tenkimotoGyo, tenkimotoRetu + 1)
Worksheets(Worksheets.Count).Range("E" & tenkiSaki).Value = uriS.Cells(tenkimotoGyo, tenkimotoRetu + 2)
Worksheets(Worksheets.Count).Range("F" & tenkiSaki).Value = uriS.Cells(tenkimotoGyo, tenkimotoRetu + 3)
tenkimotoRetu = tenkimotoRetu + 5
Next
End Sub
これが、完成形です。
実行して確認してみましょう。
現状入力されている６月発生分まで転記できました。
最後に、このプロシージャもひとつにまとめましょう。
Sub create_tokuisaki()
Call tokuisakibetu_syukei
Call tokuisaki_kensaku
Call tokuisaki_tenki
End Sub
これで本当の完成ですが、最後にボタンを追加しておきましょう。
開発タブから挿入をクリックしてボタンを選択し、「create_tokuisaki」を選んでOKを押すとボタンができます。
ボタンの名前はテキスト編集で適宜変更してください。
まとめ
いかがでしたか。
今回でご紹介した資料を自動化して作成できるようになると、管理面でミスが少なくなるでしょう。
VBAを使うかどうかは別として、今ある資料を使って今以上に効率よくミスなくできる方法はないか、を常に考えることは非常に大事です。
近視眼的になって、物事を単調にこなそうとするとそこにミスが生じやすくなるので、いつでも今以上のパフォーマンスを発揮し、変化をつけてみましょう。
きっと作業が楽しくなるはずです。
楽しみながら資料を効率化し、時間とスキルを手に入れてしまいましょう。
これからもみなさんに情報を届けていきたいと思います。
次回からはみなさん苦手な文字列操作についてご紹介していきます。
ちょっとした工夫でいろいろな処理ができるようになるので次回もお楽しみに！
みなさん、こんにちはケンケンです。 今回は、VBAで文字列を操作してみよう、という趣旨になります。 文字列操作ができると業務の幅が広がります。 例えば、住所・名前・日付などから特定の[…]
注意※プロシージャやモジュールの枠を超えて使える変数がありますが、敢えてそれはご紹介していません。
なぜなら、便利ではあるものの管理をしっかりしないと後でわけがわからなくなる可能性があるからです。
重複する変数があってもプロシージャごとに宣言したほうが分かり易いと判断して、そのようにしていますのでご理解ください。
売掛金管理ツール作成記事一覧
【ExcelVBA】集計表を使った売掛金管理①イベント処理活用【経理必見】
【ExcelVBA】集計表を使った売掛金管理②月別合計を転記する方法【経理必見】
【ExcelVBA】集計表を使った売掛金管理③得意先ごとの集計を一発処理【経理必見】