Option Explicit '年末調整クラス 'プロパティはメンバー以外アクセスできない 'プロパティの実体 '---------- 所得税計算用プロパティ ---------- Private mdblKazeiKyuyo As Double '課税給与額 Private mdblNentyoKyuyo As Double '年調給与 Private mdblKoujoGoKyuyo As Double '給与所得控除後の給与 Private mdblSyotokuKoujo As Double '所得控除 Private mdblZei As Double '税額 Private mdblGensen As Double '源泉所得税 Private mdblKanpu As Double '年末調整還付金 Private mdblGenzei As Double '特別減税 '---------- リレーションIDに対応するプロパティ ---------- Private mlngFuyou As Long '扶養控除額 Private mlngTokubetu As Long '配偶者特別控除 Private mlngSyakai As Long '社会保険料 Private mlngSyoukibo As Long '小規模企業共済 Private mlngSeimei As Long '生命保険料 Private mlngSongai As Long '損害保険料 Private mlngJutaku As Long '住宅取得控除 Private mlngZenKazei As Long '前職分課税給与 Private mlngZenSyakai As Long '前職分社会保険料 Private mlngZenZei As Long '前職分源泉所得税 '---------- 甲乙区分 ---------- Private mintKubun As Integer '「０」甲欄：「１」乙欄 'ワークシートへ書き出し Public Sub LetData(ByVal objWS1 As Worksheet, ByVal objWS2 As Worksheet, ByVal objWS3 As Worksheet, _ ByVal objWS4 As Worksheet, ByVal objWS5 As Worksheet, ByVal lngRow As Long, _ ByVal lngPID As Long, ByVal lngFID1 As Long, ByVal lngFID2 As Long, ByVal lngFID3 As Long, _ ByVal lngFID4 As Long, ByVal intKubun As Integer, ByVal lngKazei As Long, _ ByVal lngSyakai As Long, ByVal lngZei As Long) '引数[objWS1]：Sheet10 '引数[objWS2]：Sheet2 '引数[objWS3]：Sheet7 '引数[objWS4]：Sheet8 '引数[objWS5]：Sheet9 '引数[lngRow]：レコード '引数[lngPID]：主キー '引数[lngFID1]：外部キー（社員ID） '引数[lngFID2]：外部キー（配偶者特別控除ID） '引数[lngFID3]：外部キー（保険料控除ID） '引数[lngFID4]：外部キー（前職分ID） '引数[intKubun]：甲乙区分 '引数[lngKazei]：課税給与額 '引数[lngSyakai]：社会保険料 '引数[lngZei]：源泉所得税 mintKubun = intKubun '年末調整の計算 Call CalculateFuyou(objWS2, objWS3, lngFID1, lngFID2) Call CalculateSyakai(objWS4, lngFID3) Call Zensyoku(objWS5, lngFID4) Call Goukei(lngKazei, lngSyakai, lngZei) Call CalculateZei 'Call Kanpu '平成18年分特別減税対応 '平成19年廃止 'Call Tokubetu '乙欄 If mintKubun = 1 Then mdblKoujoGoKyuyo = 0 mdblSyotokuKoujo = 0 mdblZei = CDbl(mdblGensen) mdblKanpu = 0 End If 'ワークシートに書き出し objWS1.Cells(lngRow, 1).Value = lngPID objWS1.Cells(lngRow, 2).Value = lngFID1 objWS1.Cells(lngRow, 3).Value = lngFID2 objWS1.Cells(lngRow, 4).Value = lngFID3 objWS1.Cells(lngRow, 5).Value = lngFID4 objWS1.Cells(lngRow, 6).Value = mintKubun objWS1.Cells(lngRow, 7).Value = mdblKazeiKyuyo objWS1.Cells(lngRow, 8).Value = mdblKoujoGoKyuyo objWS1.Cells(lngRow, 9).Value = mdblSyotokuKoujo objWS1.Cells(lngRow, 10).Value = mdblZei objWS1.Cells(lngRow, 11).Value = mdblKanpu objWS1.Cells(lngRow, 12).Value = mlngSyakai '特別減税に対応 objWS1.Cells(lngRow, 13).Value = mdblGenzei End Sub '合算 Private Sub Goukei(ByVal lngKazei As Long, ByVal lngSyakai As Long, ByVal lngZei As Long) '引数[lngKazei]：課税給与 '引数[lngSyakai]：社会保険料 '引数[lngZei]：源泉所得税 mdblKazeiKyuyo = mdblKazeiKyuyo + CDbl(lngKazei + mlngZenKazei) '課税給与額 mlngSyakai = mlngSyakai + lngSyakai + mlngZenSyakai '社会保険料 mdblGensen = mdblGensen + CDbl(lngZei + mlngZenZei) '源泉所得税 End Sub '扶養控除の計算 Private Sub CalculateFuyou(ByVal objWS1 As Worksheet, ByVal objWS2 As Worksheet, ByVal lngFID1 As Long, ByVal lngFID2 As Long) '引数[objWS1]：Sheet2 '引数[objWS2]：Sheet7 '引数[lngFID1]：社員ID '引数[lngFID2]：配偶者特別控除ID Dim intData() As Integer '人数 Dim lngRow As Long 'レコード数 Dim i As Integer '整数型カウンタ Dim j As Long 'カレントレコード Const lngKiso As Long = 380000 '基礎 Const lngHaigusya As Long = 380000 '扶養親族 Const lngFuyou As Long = 380000 '配偶者 Const lngDokyoTokuSyougai As Long = 750000 '同居特別障害者 Const lngTokuSyogai As Long = 400000 '同居以外の特別障害 Const lngSyogai As Long = 270000 '一般の障害 Const lngKafu As Long = 270000 '一般の寡婦（夫） Const lngGakusei As Long = 270000 '勤労学生 Const lngTokuKafu As Long = 350000 '特別の寡婦 Const lngRounen As Long = 0 '老年者:2005/4/1移行廃止のため Const lngDokyoRounen As Long = 200000 '同居老親等 Const lngTokuFuyou As Long = 250000 '特定扶養親族 Const lngRoujinHaigusya As Long = 100000 '老人控除対象配偶者 Const lngRoujin As Long = 100000 '同居老親等以外の老人扶養親族 '配列再定義 ReDim intData(16) As Integer 'カレントレコードの取得 lngRow = objWS1.Cells(65536, 1).End(xlUp).Row objWS1.Activate On Error GoTo ErrorProc j = objWS1.Range(Cells(1, 1), Cells(lngRow, 1)).Find(lngFID1, , xlValues).Row 'データの取得 For i = 0 To 16 intData(i) = CInt(objWS1.Cells(j, i + 13).Value) Next '扶養控除額 mlngFuyou = CLng(intData(0) * lngKiso) mlngFuyou = mlngFuyou + CLng(intData(1) * lngKafu) mlngFuyou = mlngFuyou + CLng(intData(2) * lngTokuKafu) mlngFuyou = mlngFuyou + CLng(intData(3) * lngRounen) mlngFuyou = mlngFuyou + CLng(intData(4) * lngGakusei) mlngFuyou = mlngFuyou + CLng(intData(5) * lngHaigusya) mlngFuyou = mlngFuyou + CLng(intData(6) * lngRoujinHaigusya) mlngFuyou = mlngFuyou + CLng(intData(7) * lngFuyou) mlngFuyou = mlngFuyou + CLng(intData(8) * lngTokuFuyou) mlngFuyou = mlngFuyou + CLng(intData(9) * lngDokyoRounen) mlngFuyou = mlngFuyou + CLng(intData(10) * lngRoujin) mlngFuyou = mlngFuyou + CLng(intData(11) * lngSyogai) mlngFuyou = mlngFuyou + CLng(intData(12) * lngTokuSyogai) mlngFuyou = mlngFuyou + CLng(intData(13) * lngDokyoTokuSyougai) mlngFuyou = mlngFuyou + CLng(intData(14) * lngSyogai) mlngFuyou = mlngFuyou + CLng(intData(15) * lngTokuSyogai) '配偶者特別控除 'NULL値回避 mlngTokubetu = CLng(0) lngRow = objWS2.Cells(65536, 1).End(xlUp).Row objWS2.Activate On Error Resume Next j = objWS2.Range(Cells(1, 1), Cells(lngRow, 1)).Find(lngFID2, , xlValues).Row mlngTokubetu = CLng(objWS2.Cells(j, 12).Value) '甲乙区分の取得 mintKubun = intData(16) '配列の開放 If IsEmpty(intData) = True Then Erase intData Exit Sub ErrorProc: mlngFuyou = 0 mlngTokubetu = 0 mintKubun = 2 If IsEmpty(intData) = True Then Erase intData End Sub '社会保険料/生命保険/住宅取得控除等 Private Sub CalculateSyakai(ByVal objws As Worksheet, ByVal lngFID As Long) '引数[objWS]：Sheet8 '引数[lngFID]：社員ID Dim lngRow As Long 'レコード数 Dim i As Long 'カレントレコード 'カレントレコードの取得 lngRow = objws.Cells(65536, 1).End(xlUp).Row objws.Activate On Error GoTo ErrorProc i = objws.Range(Cells(1, 2), Cells(lngRow, 2)).Find(lngFID, , xlValues).Row 'プロパティに格納 mlngSyakai = CLng(objws.Cells(i, 3).Value) mlngSyoukibo = CLng(objws.Cells(i, 4).Value) mlngSeimei = CLng(objws.Cells(i, 5).Value) mlngSongai = CLng(objws.Cells(i, 6).Value) mlngJutaku = CLng(objws.Cells(i, 7).Value) Exit Sub ErrorProc: mlngSyakai = 0 mlngSyoukibo = 0 mlngSeimei = 0 mlngSongai = 0 mlngJutaku = 0 End Sub '前職分源泉徴収票 Private Sub Zensyoku(ByVal objws As Worksheet, ByVal lngFID As Long) '引数[objWS]：Sheet9 '引数[lngFID]：前職分ID Dim lngRow As Long '要素数 Dim i As Long '長整数型カウンタ Dim r As Long 'レコード '要素数の取得 lngRow = objws.Cells(65536, 1).End(xlUp).Row 'カレントレコードの取得 i = 0 r = 0 On Error Resume Next For i = 1 To lngRow If lngFID = CLng(Cells(i, 2).Value) Then r = i Next 'プロパティに格納 If r < 1 Then mlngZenKazei = 0 mlngZenSyakai = 0 mlngZenZei = 0 Else mlngZenKazei = CLng(objws.Cells(r, 3).Value) mlngZenSyakai = CLng(objws.Cells(r, 4).Value) mlngZenZei = CLng(objws.Cells(r, 5).Value) End If End Sub '還付金の計算 Private Sub Kanpu() mdblKanpu = mdblGensen - mdblZei End Sub '年末調整後の税額計算 Private Sub CalculateZei() Dim dblKazeihyoujun As Double '課税標準 Call Nentyokyuyo Call KoujoGoKyuyo Call SyotokuKoujo dblKazeihyoujun = mdblKoujoGoKyuyo - mdblSyotokuKoujo Call Nenzei(dblKazeihyoujun) mdblZei = Int((mdblZei - CDbl(mlngJutaku)) / 100) * 100 End Sub '---------- 年末調整の所得税計算の一連作業 ---------- '年調給与の算出 Private Sub Nentyokyuyo() '引数[lngKazeikyuyo]：課税給与 Dim lngAmari As Long '年調給与の算出 Select Case mdblKazeiKyuyo Case Is <= 1618999 mdblNentyoKyuyo = mdblKazeiKyuyo Case mdblKazeiKyuyo = 1619000 To 1619999 lngAmari = CLng((mdblKazeiKyuyo - 1619000) Mod 1000) mdblNentyoKyuyo = mdblKazeiKyuyo - CDbl(lngAmari) Case mdblKazeiKyuyo = 1620000 To 1623999 lngAmari = CLng((mdblKazeiKyuyo - 1620000) Mod 2000) mdblNentyoKyuyo = mdblKazeiKyuyo - CDbl(lngAmari) Case mdblKazeiKyuyo = 1624000 To 6599999 lngAmari = CLng((mdblKazeiKyuyo - 1624000) Mod 4000) mdblNentyoKyuyo = mdblKazeiKyuyo - CDbl(lngAmari) Case Is >= 6600000 mdblNentyoKyuyo = mdblKazeiKyuyo Case Else mdblNentyoKyuyo = CDbl(0) End Select End Sub '給与所得控除後の給与等の金額の計算 Private Sub KoujoGoKyuyo() '引数[lngNentyokyuyo]：年調給与 Select Case mdblNentyoKyuyo Case Is <= 650999 mdblKoujoGoKyuyo = CDbl(0) Case mdblNentyoKyuyo = 651000 To 1618999 mdblKoujoGoKyuyo = CDbl(mdblNentyoKyuyo - 650000) Case mdblNentyoKyuyo = 1619000 To 1619999 mdblKoujoGoKyuyo = CDbl(mdblNentyoKyuyo * 0.6 - 2400) mdblKoujoGoKyuyo = Int(mdblKoujoGoKyuyo) Case mdblNentyoKyuyo = 1620000 To 1621999 mdblKoujoGoKyuyo = CDbl(mdblNentyoKyuyo * 0.6 - 2000) mdblKoujoGoKyuyo = Int(mdblKoujoGoKyuyo) Case mdblNentyoKyuyo = 1622000 To 1623999 mdblKoujoGoKyuyo = CDbl(mdblNentyoKyuyo * 0.6 - 1200) mdblKoujoGoKyuyo = Int(mdblKoujoGoKyuyo) Case mdblNentyoKyuyo = 1624000 To 1627999 mdblKoujoGoKyuyo = CDbl(mdblNentyoKyuyo * 0.6 - 400) mdblKoujoGoKyuyo = Int(mdblKoujoGoKyuyo) Case mdblNentyoKyuyo = 1628000 To 1799999 mdblKoujoGoKyuyo = CDbl(mdblNentyoKyuyo * 0.6) mdblKoujoGoKyuyo = Int(mdblKoujoGoKyuyo) Case mdblNentyoKyuyo = 1800000 To 3599999 mdblKoujoGoKyuyo = CDbl(mdblNentyoKyuyo * 0.7 - 180000) mdblKoujoGoKyuyo = Int(mdblKoujoGoKyuyo) Case mdblNentyoKyuyo = 3600000 To 6599999 mdblKoujoGoKyuyo = CDbl(mdblNentyoKyuyo * 0.8 - 540000) mdblKoujoGoKyuyo = Int(mdblKoujoGoKyuyo) Case mdblNentyoKyuyo = 6600000 To 9999999 mdblKoujoGoKyuyo = CDbl(mdblNentyoKyuyo * 0.9 - 1200000) mdblKoujoGoKyuyo = Int(mdblKoujoGoKyuyo) Case mdblNentyoKyuyo = 10000000 To 20000000 mdblKoujoGoKyuyo = CDbl(mdblNentyoKyuyo * 0.95 - 1700000) mdblKoujoGoKyuyo = Int(mdblKoujoGoKyuyo) Case Else mdblKoujoGoKyuyo = CDbl(0) End Select End Sub '所得控除額の計算 Private Sub SyotokuKoujo() mdblSyotokuKoujo = mdblSyotokuKoujo + CDbl(mlngFuyou) mdblSyotokuKoujo = mdblSyotokuKoujo + CDbl(mlngTokubetu) mdblSyotokuKoujo = mdblSyotokuKoujo + CDbl(mlngSyakai) mdblSyotokuKoujo = mdblSyotokuKoujo + CDbl(mlngSyoukibo) mdblSyotokuKoujo = mdblSyotokuKoujo + CDbl(mlngSeimei) mdblSyotokuKoujo = mdblSyotokuKoujo + CDbl(mlngSongai) End Sub '算出年税額 Private Sub Nenzei(ByVal dblKazeihyoujun As Double) '引数[lngKazeiHyoujun]：年調課税標準 Const intKeta As Integer = 1000 '切り捨て桁数 Select Case dblKazeihyoujun Case Is < 0 mdblZei = CDbl(0) Case dblKazeihyoujun = 0 To 1950000 mdblZei = Int(CDbl((dblKazeihyoujun * 0.05) / intKeta) * intKeta) Case dblKazeihyoujun = 1950001 To 3300000 mdblZei = Int(CDbl((dblKazeihyoujun * 0.1 - 97500) / intKeta) * intKeta) Case dblKazeihyoujun = 3300001 To 6950000 mdblZei = Int(CDbl((dblKazeihyoujun * 0.2 - 427500) / intKeta) * intKeta) Case dblKazeihyoujun = 6950001 To 9000000 mdblZei = Int(CDbl((dblKazeihyoujun * 0.23 - 636000) / intKeta) * intKeta) Case dblKazeihyoujun = 9000001 To 1692000 mdblZei = Int(CDbl((dblKazeihyoujun * 0.33 - 1536000) / intkrta) * intKeta) Case Else mdblZei = mdblGensen End Select End Sub '特別減税の計算 Private Sub Tokubetu() Dim dblKari As Double Const dblRitu As Double = 0.2 Const dblGendo As Double = 250000 mdblGenzei = mdblZei * dblRitu dblKari = mdblZei - mdblGenzei If mdblGenzei <= dblGendo Then mdblZei = Int(dblKari / 100) * 100 Call Kanpu ElseIf mdblGenzei > dblGendo Then mdblZei = mdblZei = dblGendo Call Kanpu End If End Sub