Excel 給与計算マクロの解説

www.smiyasaka.com は、 2022 年 11月から Oracle LInux 8.X にＯＳを変更しました。


●　Excel マクロの解説「給与計算(見本)マクロ」編　●	2 9,988 2

「給与計算(見本)マクロ」について、簡単ですが赤字で解説を入れました。
参考になれば、幸いです。
※※ お断り ※※ ダウンロードしたマクロは、改訂のため手直しを
していますので、下記と多少違いがあります。

※ この給与計算(見本)マクロは、ある企業で実際に使用されているマクロを公開するため、必要最小限の機能にしています。 ※
使用については、地元の商工会等で結果の確認等をしてＯＫとってから、使用ください。

国税庁( https://www.nta.go.jp/ )の給与所得の源泉徴収税額表（月額表)のダウンロードは、国税庁のホームページのホーム > 税について調べる > パンフレット・手引きのページ内「源泉徴収税額表関係」から、「令和○年分源泉徴収税額表」をクリックして源泉徴収税額表から、Excel 版 [ 給与所得の源泉徴収税額表（月額表）（1から7ページ） ] のダウンロードができます。
( 該当ページの下の方にあります。)

H29年2月少し手を加えています。
国税庁のデータが更新されたときに簡単に上書き出来るようサブルーチンを二つ作成追加しています。

--------------------   ここから　UForm1のコード    ----------------------
[計算書・明細書コピー]ボタンクリックで計算書・明細書のコピーする。
Private Sub CommandButton1_Click()
    Sname = ActiveSheet.Name
    If Sname <> BBname Then Exit Sub <----  「給与基本計算書」で
    シートコピー                                    なかったら、強制終了する。
End Sub
------------------------------------------------------------------
[源泉税計算]ボタンクリックで源泉税の計算をする。
Private Sub CommandButton2_Click()
    Sname = ActiveSheet.Name
    If Sname <> BBname Then Exit Sub <----  「給与基本計算書」で
    源泉税計算                                      なかったら、強制終了する。
End Sub
------------------------------------------------------------------
[明細書へ転記]ボタンクリックで給与明細書へ、転記する。
Private Sub CommandButton3_Click()
    給与明細書設定
End Sub
------------------   ここから ThisWorkBook コード ---------------------
ブックを閉じた時に、アドインを消去する。
Private Sub Workbook_BeforeClose(Cancel As Boolean)
    Application.CommandBars("Cell").Reset
    BB02リセット
End Sub
------------------------------------------------------------------
ブックを開いた時に、アドインを表示する。
Private Sub Workbook_Open()
    Application.CommandBars("Cell").Controls(1).BeginGroup = True
    BB01セット
End Sub
-------------------   ここから　module1のコード    --------------------
マクロブック・シートの名前を定義、変数の宣言
        Dim MMM As String
        Dim G1, G2, G3, x, xx, x1, x2, xx1, xx2, Kazoku As Integer
        Dim N, NN, Kingaku, Yen  As Long
        Dim N1, N2, y, yy, y1, y2, yy1, yy2 As Integer
        Public Const BBname As String = "給与基本計算書"
        Public Const EEname As String = "H19税額表"
        Public Const FFname As String = "給与明細書"
        Public AAname, Bname, Sname As String

------------------------------------------------------------------
Excelブックがオープンした時に実行するサブルーチン
Sub auto_open()
    '----------------------------------------------------
    '  Excel 起動時にメニューバーをアドインに移動させる処理
    '----------------------------------------------------

    この様にしないといつまでも Excelブックがオープンしない
    '  タイムディレー処理  直ぐに、サブルーチン AddIN を実行させる
    Application.OnTime Now + TimeValue("00:00:00"), "AddIN" 
End Sub
------------------------------------------------------------------
メニューバーを「アドイン」に移動させる処理
Sub AddIN()
    Sheets(BBname).Select            <---- 所定のシートを表示させる
    N = Val(Application.Version)     <---- Excelのバージョンを取得する
     
Excelのバージョンの"2000 ; 9","2002 ; 10","2003 ; 11"時は、何もしない
    If N = 9 Or N = 10 Or N = 11 Then Exit Sub
    
Excelのバージョンの"2007 ; 12","2010 ; 14","2013 ; 15","2016 ; 16"
時は、アドインに移動
    '  [ALT]-->[X]-->[ALT]のキー入力を実行
    Application.SendKeys ("%X%")
    
End Sub

    '-------------------------------------------------------
'*    　　給与計算システム　　見本
'*    このマクロは、少人数の事業所では、そのまま使えると
'*    思いますが、使用に際しては、確認してから使用ください。
'*
'*    自由に変更して使用ください。計算書は、手入力欄以外は、
'*    セルの保護を掛けています。
'*        H19年度税額表使用
'*    10人以上の事業所で使用する場合は、11人目から別マクロの
'*    ブックで計算したら、良いのではないでしょうか。
    '-------------------------------------------------------
------------------------------------------------------------------
アドインの表示処理
Sub BB01セット()
    
    Dim Mycontrol As CommandBarControl
    Dim mysubmenu As CommandBarControl
    '
    Set Mycontrol = CommandBars("Worksheet Menu Bar"). _
    Controls.Add(msoControlPopup)
    Mycontrol.Caption = "【★】"
    Mycontrol.OnAction = "再表示"
End Sub
------------------------------------------------------------------
アドインの削除処理
Sub BB02リセット()
    CommandBars("Worksheet Menu Bar").Controls("【★】").Delete
End Sub
------------------------------------------------------------------
ユーザーフォームの表示処理
Sub 再表示()
    UForm1.Show vbModeless
End Sub
------------------------------------------------------------------
シート名 01-07 の５データ毎のスペースセル行を削除するサブルーチン
Sub A_スペース削除()
    '----------------------------------------------------
    ' シート名 01-07 の５データ毎のスペースセル行を 
    ' 削除するサブルーチンです。                    
    '----------------------------------------------------
    Dim S_N, E_N, II As Integer
    ' データの終わり位置を知る
    S_N = 10:   E_N = Range("A1000").End(xlUp).Row
    II = S_N
    
A_スペース削除_START:
    '    チェック位置と最終位置が同じで終了
    If II = E_N Then GoTo A_スペース削除_END:
        If ActiveSheet.Cells(II, 1).Value = "" Then <---- 文字無しセル？

            ActiveSheet.Rows(II).Select        <---- II行目を選択
            Selection.Delete Shift:=xlUp       <---- 1 行上に詰める処理
            
            ' Endセル位置 -1
            E_N = E_N - 1                    <---- 最終位置を1行文減算する
        End If
    II = II + 1:    GoTo A_スペース削除_START: <---- ループ処理
    
A_スペース削除_END:

End Sub
------------------------------------------------------------------
月額表(8,800～500,000まで)をH〇〇税額表へコピー書込みするサブルーチン
Sub A_税額表書込()
    '----------------------------------------------------
    '  月額表(8,800～500,000まで)をH〇〇税額表へ   
    '  コピー書込みするサブルーチンです。          
    '----------------------------------------------------
    Dim HZ, TZ As String
    '  使用する時には、シート名を合わせる事
    HZ = "H29税額表": TZ = "月額表"
    
    Sheets(TZ).Select                  ' 月額表　表示
    Range("B10:I175").Select           ' 月額表(8,800～500,000まで)を選択
    Selection.Copy                     ' コピー
    Sheets(HZ).Select                  ' H29税額表 表示
    Range("A6").Select
    '  文字のみを書込む
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, _
        SkipBlanks :=False, Transpose:=False
End Sub
------------------------------------------------------------------
税額表から源泉税の金額を取得する。
Sub 源泉税計算()
    「給与基本計算書」のシートから、各データの位置データを取得する。
    ' 扶養家族位置
        G1 = Worksheets(BBname).Cells(13, 62).Value
    ' 社会保険料控除後の金額(課税対象額)
        G2 = Worksheets(BBname).Cells(13, 55).Value
    ' 課税額(源泉税)
        G3 = Worksheets(BBname).Cells(13, 56).Value
    給与計算は、10人分なので10回処理を繰り返す。
    For x = 0 To 9
      With ActiveSheet
        ' 横位置     各データの横位置を取得する。
       xx = Worksheets(BBname).Cells(8, 51 + x).Value
        <----  社会保険料控除後の金額(課税対象額)を取得する。
       Kingaku = .Cells(G2, xx).Value
       金額(課税対象額)が、ゼロでなかったら、税額表を検索する。
     If Kingaku <> 0 Then
       '   税額表検索
       ' 「H19税額表」シートに金額(課税対象額)を書込む。
       Worksheets(EEname).Cells(2, 10) = Kingaku 
       '  扶養親族数を読込む。
        Kazoku = .Cells(G1, xx).Value
       '   金額が、ヒットした縦位置。
       N = Val(Worksheets(EEname).Cells(3, 10).Value)
        横位置は、扶養親族数(Kazoku)で、位置を決定する。
        '   税額表から源泉税取得を読込む。
        NN = Worksheets(EEname).Cells(N + 4, 3 + Kazoku)
        '   読込んだ源泉税を「給与基本計算書」へ書込みする。
        .Cells(G3, xx).Value = NN
       '
     Else
       '   源泉税なしの時は、0 を「給与基本計算書」へ書込む。
       .Cells(G3, xx).Value = 0
     End If
     End With
    Next x
    
End Sub

「H19税額表」の関数の設定については、「仕事に役立つExcelマクロの作り方」の「3. 関数を使い処理のスピードアップをする。」に解説しています。

--------------------------------------------------------------------------
「給与基本計算書」、「給与明細書」をコピーし、シート名をタイトルの月を付加する。
結果保存用に、不要部分のデータを消去・シート全体の書き込み禁止の保護設定をする。

Sub シートコピー()

    N = Worksheets.Count               <---- シート枚数を取得
    Worksheets(BBname).Activate        <----「給与基本計算書」を表示
    '
    Application.DisplayAlerts = False   <---- 警告メッセージの表示を停止
    MMM = ActiveSheet.Name
    「給与基本計算書」シートを最後へコピーする。
    Sheets(MMM).Copy After:=Sheets(N)
    CCC = ActiveSheet.Name
    シート名を「○月計算書」に変更する。
    Worksheets(CCC).Name = _
               Worksheets(BBname).Cells(2, 6).Value & " 月計算書"
    '--------------------------------------------------------------
    保護解除を解除する。
    ActiveSheet.Unprotect
    Cells.Select
    Selection.Locked = False
    Selection.FormulaHidden = False
    不要表示部分を消去する。
    Columns("AP:BL").Select
    Selection.Delete Shift:=xlToLeft
    Range("A2").Select
    シート全体を保護する。
        Cells.Select
    Selection.Locked = True
    Selection.FormulaHidden = False
    ActiveSheet.Protect DrawingObjects:=True, Contents:=True, _
       Scenarios:=True, AllowFormattingCells:=True
    Range("A1").Select
    '----------------------------------------------------
    N = Worksheets.Count
    Worksheets(FFname).Activate        <----  「給与明細書」を表示する。
    '
    MMM = ActiveSheet.Name
    Sheets(MMM).Copy After:=Sheets(N)
    CCC = ActiveSheet.Name
    シート名を「○月明細書」に変更する。
    Worksheets(CCC).Name = _
          Worksheets(BBname).Cells(2, 6).Value & " 月明細書"
    '--------------------------------------------------------------
    シート全体を保護する。
        Cells.Select
    Selection.Locked = True
    Selection.FormulaHidden = False
    ActiveSheet.Protect DrawingObjects:=True, Contents:=True, _
       Scenarios:=True, AllowFormattingCells:=True
    Range("A1").Select
    '
    Application.DisplayAlerts = True  <-- 警告メッセージの表示停止を解除
End Sub
------------------------------------------------------------------
　　　　  「給与基本計算書」のシートから、各データの位置データ表

---------------------------------------------------------------------
「給与基本計算書」の設定・計算結果を「給与明細書」へ転記する。

Sub 給与明細書設定()
    '
    Worksheets(FFname).Activate     <----  「給与明細書」を表示する。
    '
    With ActiveSheet
      '   給与明細書消去
      給与明細書消去を10回処理を繰り返す。
      For N = 1 To 10
        '     各データの横位置を取得する。
        y = Worksheets(BBname).Cells(1, N + 50).Value
        '
------------------------------------------------------------------------

参照しているセル位置は、上の表(位置データ表)と見比べてください。
下記のプログラムは、同じステートメントの繰り返しになっていますが、書込みセル位置は、シート上のデータを参照しているため、書込み位置が変更になってもこれらのプログラムは、変更にはなりません。私が作ってるマクロは、総てこのような手法でしています。特に処理スピードを考慮しなければならない時は別ですが、一般的には、そんなに気にする必要がないと思います。
それよりも、変更に強いマクロを組み立てる方が大事ではないかと、私は持論しています。
------------------------------------------------------------------

        ' 社員番号
        「給与基本計算書」のシートから、「給与明細書」の各データの
        縦位置データを取得する。
        x = Worksheets(BBname).Cells(2, 52).Value
        .Cells(y, x).Value = ""        <----  社員番号のセル内容を消去する。

        ' 氏名
        x = Worksheets(BBname).Cells(2, 54).Value
        .Cells(y, x).Value = ""
        ' 出勤日数
        x = Worksheets(BBname).Cells(2, 57).Value
        .Cells(y, x).Value = ""
        ' 差引支給額
        x = Worksheets(BBname).Cells(2, 62).Value
        .Cells(y, x).Value = ""
        ' 日給額
        x = Worksheets(BBname).Cells(4, 51).Value
        .Cells(y + 2, x).Value = ""
        ' 残業時間
        x = Worksheets(BBname).Cells(4, 52).Value
        .Cells(y + 2, x).Value = ""
        ' 基本給
        x = Worksheets(BBname).Cells(4, 53).Value
        .Cells(y + 2, x).Value = ""
        ' 給与(日給)
        x = Worksheets(BBname).Cells(4, 54).Value
        .Cells(y + 2, x).Value = ""
        ' 残業手当
        x = Worksheets(BBname).Cells(4, 55).Value
        .Cells(y + 2, x).Value = ""
        ' 家族手当
        x = Worksheets(BBname).Cells(4, 56).Value
        .Cells(y + 2, x).Value = ""
        ' 役職手当
        x = Worksheets(BBname).Cells(4, 57).Value
        .Cells(y + 2, x).Value = ""
        ' 皆勤手当
        x = Worksheets(BBname).Cells(4, 58).Value
        .Cells(y + 2, x).Value = ""
        ' 職能手当
        x = Worksheets(BBname).Cells(4, 59).Value
        .Cells(y + 2, x).Value = ""
        ' 非課税通勤費
        x = Worksheets(BBname).Cells(4, 61).Value
        .Cells(y + 2, x).Value = ""
        ' 支払額
        x = Worksheets(BBname).Cells(4, 63).Value
        .Cells(y + 2, x).Value = ""
        ' 健康保険
        x = Worksheets(BBname).Cells(6, 51).Value
        .Cells(y + 4, x).Value = ""
        ' 厚生年金
        x = Worksheets(BBname).Cells(6, 52).Value
        .Cells(y + 4, x).Value = ""
        ' 雇用保険
        x = Worksheets(BBname).Cells(6, 53).Value
        .Cells(y + 4, x).Value = ""
        ' 保険料合計
        x = Worksheets(BBname).Cells(6, 54).Value
        .Cells(y + 4, x).Value = ""
        ' 社会保険控除後の合計
        x = Worksheets(BBname).Cells(6, 55).Value
        .Cells(y + 4, x).Value = ""
        ' 源泉税
        x = Worksheets(BBname).Cells(6, 56).Value
        .Cells(y + 4, x).Value = ""
        ' 住民税
        x = Worksheets(BBname).Cells(6, 57).Value
        .Cells(y + 4, x).Value = ""
        ' 税金合計
        x = Worksheets(BBname).Cells(6, 59).Value
        .Cells(y + 4, x).Value = ""
        ' 年末調整
        x = Worksheets(BBname).Cells(6, 60).Value
        .Cells(y + 4, x).Value = ""
        ' 控除合計
        x = Worksheets(BBname).Cells(6, 63).Value
        .Cells(y + 4, x).Value = ""
      Next N

     給与基本計算書

------------------------------------------------------------------------
　　　　                               給与明細書

------------------------------------------------------------------------

      '------------------------------------------------------------
      '            計算書　--->　明細書へ転記
      '------------------------------------------------------------
      「給与基本計算書」のシートから、「給与明細書」へ転記をする。
      For N = 1 To 10
   「給与基本計算書」のシートから、「給与基本計算書」の各データの
   横位置データを取得する。
        xx1 = Worksheets(BBname).Cells(8, N + 50).Value
   「給与基本計算書」のシートから、「給与明細書」の各データの
   縦位置データを取得する。
        yy2 = Worksheets(BBname).Cells(1, N + 50).Value
        '
        ' 社員番号
   「給与基本計算書」のシートから、「給与基本計算書」の各データの
   縦位置データを取得する。
        yy1 = Worksheets(BBname).Cells(9, 52).Value
   「給与基本計算書」のシートから、「給与明細書」の各データの
   横位置データを取得する。
        x2 = Worksheets(BBname).Cells(2, 52).Value
     「給与基本計算書」から、金額データを読込み、0 かを判定と書込み。
   '  「給与明細書」へ、金額データを書込む。
        y3 = yy2: SZero Zero, yy1, xx1, y3
        ' 氏名
        yy1 = Worksheets(BBname).Cells(9, 54).Value
        x2 = Worksheets(BBname).Cells(2, 54).Value
        y3 = yy2: SZero Zero, yy1, xx1, y3
        ' 出勤日数
        yy1 = Worksheets(BBname).Cells(9, 57).Value
        x2 = Worksheets(BBname).Cells(2, 57).Value
        y3 = yy2: SZero Zero, yy1, xx1, y3
        ' 差引支給額
        yy1 = Worksheets(BBname).Cells(9, 62).Value
        x2 = Worksheets(BBname).Cells(2, 62).Value
        y3 = yy2: SZero Zero, yy1, xx1, y3
        
        ' 日給額
        yy1 = Worksheets(BBname).Cells(11, 51).Value
        x2 = Worksheets(BBname).Cells(4, 51).Value
        y3 = yy2 + 2: SZero Zero, yy1, xx1, y3
        ' 残業時間
        yy1 = Worksheets(BBname).Cells(11, 52).Value
        x2 = Worksheets(BBname).Cells(4, 52).Value
        y3 = yy2 + 2: SZero Zero, yy1, xx1, y3
        ' 基本給
        yy1 = Worksheets(BBname).Cells(11, 53).Value
        x2 = Worksheets(BBname).Cells(4, 53).Value
        y3 = yy2 + 2: SZero Zero, yy1, xx1, y3
        ' 給与(日給)
        yy1 = Worksheets(BBname).Cells(11, 54).Value
        x2 = Worksheets(BBname).Cells(4, 54).Value
        y3 = yy2 + 2: SZero Zero, yy1, xx1, y3
        ' 残業手当
        yy1 = Worksheets(BBname).Cells(11, 55).Value
        x2 = Worksheets(BBname).Cells(4, 55).Value
        y3 = yy2 + 2: SZero Zero, yy1, xx1, y3
        ' 家族手当
        yy1 = Worksheets(BBname).Cells(11, 56).Value
        x2 = Worksheets(BBname).Cells(4, 56).Value
        y3 = yy2 + 2: SZero Zero, yy1, xx1, y3
        ' 役職手当
        yy1 = Worksheets(BBname).Cells(11, 57).Value
        x2 = Worksheets(BBname).Cells(4, 57).Value
        y3 = yy2 + 2: SZero Zero, yy1, xx1, y3
        ' 皆勤手当
        yy1 = Worksheets(BBname).Cells(11, 58).Value
        x2 = Worksheets(BBname).Cells(4, 58).Value
        y3 = yy2 + 2: SZero Zero, yy1, xx1, y3
        ' 職能手当
        yy1 = Worksheets(BBname).Cells(11, 59).Value
        x2 = Worksheets(BBname).Cells(4, 59).Value
        y3 = yy2 + 2: SZero Zero, yy1, xx1, y3
        ' 非課税通勤費
        yy1 = Worksheets(BBname).Cells(11, 61).Value
        x2 = Worksheets(BBname).Cells(4, 61).Value
        y3 = yy2 + 2: SZero Zero, yy1, xx1, y3
        ' 支給額
        yy1 = Worksheets(BBname).Cells(11, 63).Value
        x2 = Worksheets(BBname).Cells(4, 63).Value
        y3 = yy2 + 2: SZero Zero, yy1, xx1, y3
        
        ' 健康保険
        yy1 = Worksheets(BBname).Cells(13, 51).Value
        x2 = Worksheets(BBname).Cells(6, 51).Value
        y3 = yy2 + 4: SZero Zero, yy1, xx1, y3
        ' 厚生年金
        yy1 = Worksheets(BBname).Cells(13, 52).Value
        x2 = Worksheets(BBname).Cells(6, 52).Value
        y3 = yy2 + 4: SZero Zero, yy1, xx1, y3
        ' 雇用保険
        yy1 = Worksheets(BBname).Cells(13, 53).Value
        x2 = Worksheets(BBname).Cells(6, 53).Value
        y3 = yy2 + 4: SZero Zero, yy1, xx1, y3
        ' 保険料合計
        yy1 = Worksheets(BBname).Cells(13, 54).Value
        x2 = Worksheets(BBname).Cells(6, 54).Value
        y3 = yy2 + 4: SZero Zero, yy1, xx1, y3
        ' 社保控除後の金額
        yy1 = Worksheets(BBname).Cells(13, 55).Value
        x2 = Worksheets(BBname).Cells(6, 55).Value
        y3 = yy2 + 4: SZero Zero, yy1, xx1, y3
        ' 源泉税
        yy1 = Worksheets(BBname).Cells(13, 56).Value
        x2 = Worksheets(BBname).Cells(6, 56).Value
        y3 = yy2 + 4: SZero Zero, yy1, xx1, y3
        ' 住民税
        yy1 = Worksheets(BBname).Cells(13, 57).Value
        x2 = Worksheets(BBname).Cells(6, 57).Value
        y3 = yy2 + 4: SZero Zero, yy1, xx1, y3
        ' 税金合計
        yy1 = Worksheets(BBname).Cells(13, 59).Value
        x2 = Worksheets(BBname).Cells(6, 59).Value
        y3 = yy2 + 4: SZero Zero, yy1, xx1, y3
        ' 年末調整
        yy1 = Worksheets(BBname).Cells(13, 60).Value
        x2 = Worksheets(BBname).Cells(6, 60).Value
        y3 = yy2 + 4: SZero Zero, yy1, xx1, y3
        ' 控除合計
        yy1 = Worksheets(BBname).Cells(13, 63).Value
        x2 = Worksheets(BBname).Cells(6, 63).Value
        y3 = yy2 + 4: SZero Zero, yy1, xx1, y3
      Next N
    End With
End Sub
------------------------------------------------------------------
数値 0 の時、0を表示しないようにするサブルーチン。
Sub SZero(Zero, yy1, xx1, y3 As Variant)
'「給与基本計算書」から、読込んだ金額が、0 の時は、文字なし("")にする。
    '
    Zero = Worksheets(BBname).Cells(yy1, xx1).Value
    ' 0円の時には、文字無しにする
    If Zero = 0 Then Zero = ""
    ActiveSheet.Cells(y3, x2).Value = Zero
    '
End Sub

戻る

● Excel マクロの解説 「 給与計算(見本)マクロ 」編 ●

●　Excel マクロの解説「給与計算(見本)マクロ」編　●