消費税8%と10%が混ざったレシートの会計ソフトへのデータ入力を楽にしたくてExcelマクロ（ユーザーフォーム）を作ってみた件。

Private Sub MyTotalAmount()

'■税込金額を計算して合計金額を表示する一連の作業

On Error GoTo myerror

Dim total As Long
Dim komi8 As Long
Dim komi10 As Long
Dim i As Long
Dim hiduke As String


'■日付を作成する

hiduke = DateSerial(meTextyear, meTextmonth, meTextDay)


'■８％の税込金額を計算して表示する

komi8 = Int(meText8 * 1.08)


meText8komi.Text = Format(komi8, "#,##0")
meLabel8tax.Caption = Val(komi8) - Val(meText8)


'■10％の税込金額を計算して表示する

komi10 = Int(meText10 * 1.1)

meText10komi.Text = Format(komi10, "#,##0")
meLabel10tax.Caption = Val(komi10) - Val(meText10)



On Error GoTo 0



'■合計金額を表示する

total = Val(komi8) + Val(komi10)

meTotalAmount.Caption = Format(total, "##,#0")

meCommandButton1.Enabled = True



'■仕訳イメージに作成した仕訳を表示する


With ListBox1

    
    '1行目の仕訳
        
    .AddItem hiduke
    .List(0, 1) = "諸口　/"
    .List(0, 2) = meTextkasikata
    .List(0, 3) = meTotalAmount.Caption
    .List(0, 4) = meTextTekiyou
    
    
    '2行目の仕訳
    
    .AddItem hiduke
    .List(1, 1) = meTextkarikata
    .List(1, 2) = "/　諸口"
    .List(1, 3) = meText8komi.Text
    .List(1, 4) = meTextTekiyou & "　8％軽減税率分"
    
    
    '３行目の仕訳
    
     .AddItem hiduke
    .List(2, 1) = meTextkarikata
    .List(2, 2) = "/　諸口"
    .List(2, 3) = meText10komi.Text
    .List(2, 4) = meTextTekiyou & "　10%分"

 

End With


myerror:

    '■エラーが発生した時（金額欄に何も入力されていない時）は何もしない。

End Sub

Private Sub meText8_AfterUpdate()

'金額計算　8％

If IsNumeric(meText8) = False Then

    MsgBox "入力した値が不正です", vbExclamation
    meText8.Text = ""
    meText8.SetFocus
    
    Exit Sub
    
    
End If


Call MyTotalAmount

End Sub

Private Sub meText10_AfterUpdate()

'金額計算　10％

If IsNumeric(meText10) = False Then

    MsgBox "入力した値が不正です", vbExclamation
    meText10.Text = ""
    meText10.SetFocus
    
    Exit Sub
    
    
    
End If


Call MyTotalAmount

End Sub

Private Sub CheckBox1_Change()

'■チェックボックスにチェックが入ったら入力順を変更する

If CheckBox1.Value = True Then

    meText8.TabIndex = 7
    meText10.TabIndex = 6
    MsgBox "入力の順番を10％、8％軽減の順に変更します"


Else

    meText8.TabIndex = 6
    meText10.TabIndex = 7
    MsgBox "入力の順番を8％軽減、10％の順に変更します"

End If

End Sub

Private Sub meCommandButton1_Click()

'■登録ボタンが押された時の処理

Dim i As Long
Dim lastrow As Long
Dim hiduke As String
Dim yayoiadd3(2, 24) As Variant  '仕訳転記用の配列


lastrow = Sheets(1).Cells(Rows.Count, 1).End(xlUp).Row + 1


'■日付を作成する

hiduke = DateSerial(meTextyear, meTextmonth, meTextDay)



'■1行目の追加する仕訳の項目を設定して配列yayoiadd3に格納する。


yayoiadd3(0, 0) = 2000 '識別フラグ
yayoiadd3(0, 3) = hiduke '日付
yayoiadd3(0, 4) = "諸口" '借方科目
yayoiadd3(0, 7) = "対象外" '借方消費税区分
yayoiadd3(0, 8) = meTotalAmount '借方金額
yayoiadd3(0, 9) = ""  '借方消費税金額
yayoiadd3(0, 10) = meTextkasikata '貸方科目
yayoiadd3(0, 13) = "対象外" '貸方消費税区分
yayoiadd3(0, 14) = yayoiadd3(0, 8) '貸方金額
yayoiadd3(0, 15) = yayoiadd3(0, 9) '貸方消費税金額
yayoiadd3(0, 16) = meTextTekiyou '摘要欄
yayoiadd3(0, 19) = 0
yayoiadd3(0, 24) = "no"


'■2行目の追加する仕訳の項目を設定して配列yayoiadd3に格納する。
'使用しない項目はコメントアウトしておくこと。

yayoiadd3(1, 0) = 2000 '識別フラグ
yayoiadd3(1, 3) = hiduke '日付
yayoiadd3(1, 4) = meTextkarikata
yayoiadd3(1, 7) = "課対仕入込軽減8%"
yayoiadd3(1, 8) = meText8komi '借方金額
yayoiadd3(1, 9) = Val(meLabel8tax.Caption)  '借方消費税金額
yayoiadd3(1, 10) = "諸口"
yayoiadd3(1, 13) = "対象外"
yayoiadd3(1, 14) = yayoiadd3(1, 8)
yayoiadd3(1, 15) = yayoiadd3(1, 9) '貸方消費税金額
yayoiadd3(1, 16) = meTextTekiyou & "　8%軽減税率"
yayoiadd3(1, 19) = 0
yayoiadd3(1, 24) = "no"


'■3行目の追加する仕訳の項目を設定して配列yayoiadd3に格納する。
'使用しない項目はコメントアウトしておくこと。

yayoiadd3(2, 0) = 2000 '識別フラグ
yayoiadd3(2, 3) = hiduke '日付
yayoiadd3(2, 4) = meTextkarikata
yayoiadd3(2, 7) = "課対仕入込10%"
yayoiadd3(2, 8) = meText10komi '借方金額
yayoiadd3(2, 9) = Val(meLabel10tax.Caption)  '借方消費税金額
yayoiadd3(2, 10) = "諸口"
yayoiadd3(2, 13) = "対象外"
yayoiadd3(2, 14) = yayoiadd3(2, 8)
yayoiadd3(2, 15) = yayoiadd3(2, 9) '貸方消費税金額
yayoiadd3(2, 16) = meTextTekiyou & "　10%税率"
yayoiadd3(2, 19) = 0
yayoiadd3(2, 24) = "no"


Range(Range("a" & lastrow), Range("y" & lastrow).Offset(2, 0)).Value = yayoiadd3

'チェックボックスにチェックがある場合には仕訳の並び順を変更する

If CheckBox1.Value = True Then

    lastrow = Cells(Rows.Count, 1).End(xlUp).Row

    Rows(lastrow - 1).Cut
    Rows(lastrow + 1).Insert Shift:=xlDown

End If

'■金額欄をクリアする

meTextDay.Text = ""
meText8.Text = ""
meText10 = ""
meTexttyousei.Text = ""
meLabel8tax.Caption = ""
meLabel10tax.Caption = ""
meText10komi.Text = ""
meText8komi.Text = ""
meTotalAmount.Caption = ""


'■登録ボタンを選択不可に変更する

meCommandButton1.Enabled = False

'■仕訳イメージの表示をクリアする

ListBox1.Clear


'■日付欄にフォーカスを移動する

meTextDay.SetFocus


End Sub