EXCEL VBA バス運賃・電車運賃の料金集計「サンプルプログラム」（テクニック）

●はじめに

社内の従業員に対して、毎月交通費の精算を定期的に行うと思いますが、数人の従業員でしたら、EXCELの関数を使って計算する事も可能ですが、数百人以上の従業員を抱える会社では、交通費を管理する専用のソフトを購入する必要があると思います。専用ソフトもなかなか費用も掛かるので、EXCEL VBAを使って簡易的なバス運賃・電車運賃を集計するプログラムを作成いたしました。このような、簡易プログラムでも社内で上手く利用する事で、業務の効率化を図る事が出来ると思います。それでは、バス運賃・電車運賃を集計する簡易プログラムの作成方法を順番に説明いたします。

●EXCEL VBA Google Chrome(グーグルクローム)の操作・乗換案内・交通費精算・定期代・webスクレイピング（テクニック）

片道のバス料金から月額（回数）の利用料金を算出　（６ヵ月分）

●プログラム説明　（サンプルプログラム①）
（画面クリックして拡大）

①シート『運賃別・回数別一覧』に、『バス　乗車回数・片道運賃別一覧』表を作成しており、「片道運賃」と「乗車回数」により、表から該当する運賃を抽出出来る様に一覧表を作成します。

②シート『運賃計算（バス）』では、社員毎に一覧表として表示されている内容に、バス運賃・乗車回数に対して、該当するバス代を上記表より抽出して、6ヶ月分のバス代として計算を行い結果を表示させます。

Sub BusRyoukin()

    Dim ws01, ws02 As Worksheet
    Dim L, I, M, lRow, xRow, mRow As Long

       
    Set ws01 = Worksheets("運賃計算（バス）")
    Set ws02 = Worksheets("運賃別・回数別一覧")


    xRow = ws01.Cells(Rows.Count, "A").End(xlUp).Row  'シート（運賃計算）A列最終行
    
    lRow = ws02.Cells(Rows.Count, "A").End(xlUp).Row  'シート（運賃別・回数別一覧）A列最終行
    
    For I = 2 To xRow  'シート（運賃計算）２行目～最終行まで、ループ
   
    mRow = 0
    
        On Error Resume Next  'エラーが発生しても続行する。
                mRow = WorksheetFunction.Match(ws01.Cells(I, "C"), ws02.Range("A5:A" & lRow), 0) + 4  'シート（運賃計算）から社員ごとの「運賃単価」とシート（運賃別・回数別一覧）から同一運賃の行を求める
                
        On Error GoTo 0
        
        If mRow = 0 Then
                ws01.Cells(I, "E") = "該当のデータ無し"  '該当する運賃が無ければ、「該当のデータ無し」と表示する。
        
            Else
                ws01.Cells(I, "E") = (ws02.Cells(mRow, ws01.Cells(I, "D") - 18)) * 6    'シート（運賃別・回数別一覧）から運賃・乗車回数に該当する料金を求めて、６を掛けて：６か月分に計算します。
                
            
        End If
    Next I


End Sub

●実行前～実行後　※プログラム実行後、社員毎にC列「運賃」・D列「乗車回数」に登録されているデータを元に、『バス　乗車回数・片道運賃別一覧』を参照して、バス代の結果を計算してE列に結果を表示しました。

片道の電車料金から月額（回数）の利用料金を算出

●プログラム説明　（サンプルプログラム②）
（画面クリックして拡大）

①シート『電車運賃表』では、乗車駅から降車駅までの運賃が分かる一覧表を作成して、乗車駅と降車駅の組み合わせにより、該当する運賃を求める表を作成します。

②シート『運賃計算（電車）』では、社員毎に一覧表として登録されている内容に、乗車駅・降車駅に対して、該当する電車代を上記表より抽出して、片道運賃と月額運賃（乗車回数×片道運賃）の計算を行い結果を表示させます。

Sub trainRyoukin()

    Dim ws01, ws02 As Worksheet
    Dim L, I, M, lRow, xRow, mRow As Long
    Dim Train_In, Train_Out, Train_Hit01, Train_Hit02 As Range
    Dim Train_X, Train_Y As String
       
    Set ws01 = Worksheets("運賃計算 (電車)")
    Set ws02 = Worksheets("電車運賃表")

    Set Train_In = ws02.Range("A2:A7")    'シート（電車運賃表）の乗車駅名を範囲セットします。（行）
    Set Train_Out = ws02.Range("B1:G1")  'シート（電車運賃表）の降車駅名を範囲セットします。（列）

    xRow = ws01.Cells(Rows.Count, "A").End(xlUp).Row  'シート（運賃計算 (電車)）A列の最終行
    
    
    For I = 2 To xRow  'シート（運賃計算）２行目～最終行まで、ループ
   
        Train_X = ws01.Cells(I, "C") '乗車駅セット
        Train_Y = ws01.Cells(I, "D") '降車駅セット
   
   
        Set Train_Hit01 = Train_In.Find(what:=Train_X, lookat:=xlWhole)  '乗車駅（セル）位置を把握する。
    
        Set Train_Hit02 = Train_Out.Find(what:=Train_Y, lookat:=xlWhole)  '降車駅（セル）位置を把握する。
    
    
        If Train_Hit01 Is Nothing Or Train_Hit02 Is Nothing Then
                ws01.Cells(I, "F") = "該当駅なし"  '乗車駅または、降車駅が電車運賃表に該当しなければ、「該当駅なし」と表示する。
            Else
                ws01.Cells(I, "F") = ws02.Cells(Train_Hit01.Row, Train_Hit02.Column)  'シート（電車運賃表）より、該当する乗車駅（行）,降車駅（列）により運賃を代入します。
                ws01.Cells(I, "G") = ws01.Cells(I, "F") * ws01.Cells(I, "E")  '運賃×乗車回数を掛けた合計を計算します。
        End If
    Next I


End Sub

●実行前～実行後　※プログラム実行後、社員毎にC列：乗車駅・D列：「降車駅」・E列「乗車回数」に登録されているデータを元に、『電車運賃表』を参照して、片道の運賃と月額の運賃の結果を計算してF列「片道運賃」・G列「月額運賃」に結果を表示しました。

最後まで、ご覧いただきまして誠に有難うございました。
また、VBAに関するテクニックや便利な手法などをこのサイトに掲載していきますので、定期的に参照していただけると幸いです。

AKIRA