VBAマクロを使って給料明細を作成したい

質問

ＶＢＡのマクロを使用し給料明細を作りたいのですが初心者のため全くわかりません。研修で使用するつもりです

シート１（明細書元）に給料明細となるものがあります。
シート２（入力）に名前（Ｂ列）、基本給（Ｃ列）、交通費（Ｄ列）、調整分（Ｅ列）、住民税（Ｇ列）が書いてあります。

入力シートにコマンドボタンを置きクリックされると
(1)支給日時表示
(2)Ｂ３に値が入っているかチェック（入っていない場合はMsgBoxで表示）
(3)シートを入力シートにかえてＢ列で値が入っているところまでを検索（j=Range("A65536").End(xlUp).Row）
(4)Ｂ列に数値が含まれていないかどうかチェック（含まれている場合はMsgBoxで表示）→For文
(5)基本給（Ｃ列）に値が入っているかチェック（入っていない場合はMsgBox)
(6)基本給が数値かどうか（For）
(7)交通費（Ｄ列）、調整分（Ｅ列）、住民税（Ｇ列）に値が入っているかチェック（入っていなくてもエラー表示はしない）（For）
(8)(7)で入っているところの値が数値かどうかチェック（For)
(9)配列を使用し所得税、厚生年金、雇用保険を計算（一人一人繰り返していくのではなく所得税は所得税で計算したい

下記がまだ途中までのマクロになります
--------------------
Private Sub Commandbuttton1_Click()
Worksheets（"明細書元").Range("F7")=Format(Date,"ggge年m月")&"支給分"

　　Sheets("入力").Activate
If Worksheets("入力").range("B3")="" Then
　　　MsgBox("値を入力してください")
　　Else

-----------
全くできていないのですがここまではできたのですがうまくいきません。

分かりやすく、かつ主にIfとLoop、For1を使って作りたいのですが教えてください。

わかりにくいとは思いますが今日中に知りたいのでよろしくお願いします

回答No.2

argument

こんばんわ　ka2ari1226　さん
まったくもって日曜が休日だと誰が決めたのでしょう。
残念ながら私の日曜は休日ではありませんでした。
さて、今先ほど戻ってきたものの、あなたの為に作業しようと思ったら残念な事に私のVBEは")"が足りないと言い、"serect"って何ですか？と私にエラーを元気良くそして分かりづらく教えてくれました。
サンプルソースせめて一度VBEで打ってからの方が良いでしょう。
まぁそれは良いでしょう。この程度なんとなくで分かるのですから。

前回も述べていますがどのデータがどこから始まるのでしょうか？
私はあなたのシートがいまいち想像できません。
残念な事に私には超能力であなたのシートを念写する事も叶いません。
forが1から始まらないということは1セルからデータがある訳ではないのでしょう？

>nとはn=Range("A65536").End(xlUp).Rowでやったもののnになります
これは各列のnとはn=Range("各列65536").End(xlUp).Rowでしょうか？
現状からテスト実行しようにもテストデータをどのように入れるべきか
・・・さぁ困りました。

さて、このまま補足回答がなければ私はかなり想像でセルを予想し作成する羽目になるのですがもちろん貴方の予想を通り動作する可能性は低下します。

今日と言う制限は後一時間ほどですね。さて気楽に作業しますか。

補足

argumentさんこんにちは。

総支給額の計算は試行錯誤の上できました。

しかし、配列で計算したものが貼り付けられません。

配列で間違えているところがあれば指摘していただきたいと思います。

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

For i = 3 To n '所得税計算
Dim shotku() As Long
ReDim shotoku(n - 1)
Dim atai As Long

atai = Worksheets("入力").Range("D" + CStr(i))

Select Case atai
Case Is < 1950000
Dim zeiritu As Integer
Const zeiritu1 = 0.05

shotoku(n) = atai * 0.05

Case 1950000 To 3300000
Const zeiritu2 = 0.1

shotoku(n - 1) = atai * 0.1 - 97500

Case 3300000 To 6950000
Const zeiritu3 = 0.2

shotoku(n - 1) = atai * 0.2 - 427500

Case 6950000 To 9000000
Const zeiritu4 = 0.23

shotoku(n - 1) = atai * 0.23 - 636000

Case 9000000 To 18000000
Const zeiritu5 = 0.33

shotoku(n - 1) = atai * 0.33 - 1536000

Case Is >= 18000000
Const zeiritu6 = 0.4

shotoku(n - 1) = atai * 0.4 - 2796000
End Select
Next

For i = 3 To n '健康保険料計算
Dim kenko() As Long
ReDim kenko(n)
Dim age As Long
age = Worksheets("入力").Range("C" + CStr(i))

If Worksheets("入力").Range("D" + CStr(i)) < 93000 Then
kenko(n) = 0
Else
Select Case age
Case 20 To 39
kenko(n) = 93000 * 0.082 / 2

Case 40 To 64
kenko(n) = 93000 * 0.0933 / 2
End Select
End If
Next

For i = 3 To n '厚生年金計算
Dim nenkin() As Long
ReDim nenkin(n)

If Worksheets("入力").Range("D" + CStr(i)) < 93000 Then
nenkin(n) = 0
Else
nenkin(n) = 93000 * 0.14996 / 2
End If
Next

For i = 3 To n '雇用保険料計算
Dim koyo() As Long
ReDim koyo(n)
Dim kihon As Long, tukin As Long, chosei As Long
kihon = Worksheets("入力").Range("D" + CStr(i))
tukin = Worksheets("入力").Range("E" + CStr(i))
chosei = Worksheets("入力").Range("F" + CStr(i))

koyo(n) = kihon + tukin + chosei * 0.006
Next

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

このあとに貼り付けがあるんですがよろしくお願いします

回答No.1

argument

夜遅くにこんばんは
はじめまして　ka2ari1226　さん
残念ながら「>今日中に知りたいので…」の時点で回答する意味はまったく無いのでしょう。私が見つけたのがこんな時間なのが残念です。

ですが回答を用意しました。これは貴方のための苦心したもしくは私自身の興味を満たすために書いたものです。

けれどこれも又真に残念なことに貴方の日本語力が足りないのかもしくは私自身の日本語力が足りないために完全な回答を用意することができませんでした(きっと後者なのでしょう)。

事前に確認しておきます
>シート２（入力）に名前（Ｂ列）、基本給（Ｃ列）、交通費（Ｄ列）、調整分（Ｅ列）、住民税（Ｇ列）が書いてあります。
はそれぞれの値が入っているだけで項目は無いのですよね？
なぜならば項目があるならば各項目は「[B:1]に名前」などセルの位置が無ければ特定できないからです。けれど安心してください。
列になんのデータが入るかさえわかれば項目など無くても例マクロはつくれます。
それにこれは難解な問題ではなく貴方の言うようにifとforさえあれば簡単に回答が得る事ができる初歩的な課題です。
(そう貴方が自分から初心者と言う以上私はdoやwhileはたまたCaseそれにexit subもexit forも便利なもしくは式を短くできる構文使うことができませんでした)

それでは以下を回答例として提示します。

Private Sub CommandButton1_Click()

'(1)支給日時表示
Worksheets("明細書元").Range("F7") = Format(Date, "ggge年m月") & "支給分"

'？　シートを(3)の場所で変えるのかここで変えるのか・・
'まぁ書いてあるサンプル優先でここで変えるのでしょうね
Sheets("入力").Activate

'(2)Ｂ３に値が入っているかチェック（入っていない場合はMsgBoxで表示）
If Worksheets("入力").Range("B3") = "" Then MsgBox ("[B:3]に値を入力してください")

'(3)シートを入力シートにかえてＢ列で値が入っているところまでを検索
j = Range("B65536").End(xlUp).Row

'(4)Ｂ列に数値が含まれていないかどうかチェック（含まれている場合はMsgBoxで表示）→For文
For i = 1 To j
For i2 = 0 To 9
If InStr(StrConv(Range("B" & i), vbNarrow), i2) > 0 Then MsgBox ("[B:" & i & "]に数値が含まれています")
Next
Next

'(5)基本給（Ｃ列）に値が入っているかチェック（入っていない場合はMsgBox)
'項目があるなら絶対msgboxは反応しません。ですが条件に項目があるなど書いていません。
'ならば私は1行目から最終行までチェックせざる得ません。
For i = 1 To Range("C65536").End(xlUp).Row
temp = temp & Range("C" & i)
Next
If temp = "" Then MsgBox "C列には値がありません"

'(6)基本給が数値かどうか（For）
'項目があるなら絶対msgboxが反応します。ですが条件に項目があるなど書いていません。
'ならば私は1行目から最終行までチェックせざる得ません。
'数値が全角か半角かの指定はありませんならば私は数値ならば許容しなければなりません
For i = 1 To Range("C65536").End(xlUp).Row
If Not IsNumeric(StrConv(Range("C" & i).Value, vbNarrow)) Then MsgBox "[C:" & i & "]は数値ではありません"
Next

'(7)交通費（Ｄ列）、調整分（Ｅ列）、住民税（Ｇ列）に値が入っているかチェック（入っていなくてもエラー表示はしない）（For）
For i = 1 To Range("D65536").End(xlUp).Row
If Range("D" & i).Value <> "" Then ddata = ddata & i & ","
Next
For i = 1 To Range("E65536").End(xlUp).Row
If Range("E" & i).Value <> "" Then edata = edata & i & ","
Next
For i = 1 To Range("G65536").End(xlUp).Row
If Range("G" & i).Value <> "" Then gdata = edata & i & ","
Next
ddata = Left(ddata, Len(ddata) - 1)
edata = Left(edata, Len(edata) - 1)
gdata = Left(gdata, Len(gdata) - 1)

'(8)(7)で入っているところの値が数値かどうかチェック（For)
'チェックはしましたが何もしていません。なぜならチェックとしか書いてないからです。
'そのため何もしない処理を追加しています。
If ddata <> "" Then
ddata = Split(ddata, ",")
For i = 0 To UBound(ddata)
If Not IsNumeric(StrConv(Range("D" & ddata(i)).Value, vbNarrow)) Then
End If
Next
End If
If edata <> "" Then
edata = Split(edata, ",")
For i = 0 To UBound(edata)
If Not IsNumeric(StrConv(Range("E" & edata(i)).Value, vbNarrow)) Then
End If
Next
End If
If gdata <> "" Then
gdata = Split(gdata, ",")
For i = 0 To UBound(gdata)
If Not IsNumeric(StrConv(Range("G" & gdata(i)).Value, vbNarrow)) Then
End If
Next
End If

'(9)配列を使用し所得税、厚生年金、雇用保険を計算（一人一人繰り返していくのではなく所得税は所得税で計算したい
'残念ならがこれに答えることはできません。なぜならば値がどのように格納されどこにあるのか
'ましてや例すらないのですから・・。これは答える事のできない質問と言わざるえません。

End Sub

事前にのべましたが「>今日中」の部分が非常に残念で仕方ありません。これは私がポイントが欲しいと思うよりも次回貴方がマクロを組むときにスムーズに作れるようになるための一例です。
なぜ三項目「暇なときにでも」「困ってます」「すぐに回答を！」のうち「すぐに回答を！」を選択しなかったのかも疑問ですが、それはまぁきっと押し間違えたのでしょう。そう信じて疑いません。

もしも今回の例が間違っているもしくは実は補足があるのならいつでもいって下さい。きっとまた貴方の欲しい時に回答はできなかも知れませんがいつかまた回答することができるかと思います。

補足

argumentさんありがとうございます。

補足で再び質問なんですが
明細書元に金額を表示までできたのですが
それぞれの形で計算ができません。

入力シートから貼り付けをした後に
明細書元にある総支給額（"K"+CStr(i))と書いてあるセルに表示させたいんです。

それぞれ貼り付け方法をソースで書いたものを乗せます。
どうかっ今日中にお返事くれるとありがたいです。
大文字、小文字は気にしないでください。
会社の奴の研修材料のを家に持って返ってやっているので印刷したのを打ち込んでるので

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

＜上部省略＞
'入力シートで名前（B列）が書いてある数だけ明細書元を同じシートにコピーする
For i=3 To n-1
worksheets("明細書元").Range("A1:L22").copy
worksheets("明細書元").Serect
activesheet.range("a"+CStr(22*(i-2)+1).select
activesheet.paste
next
'Ｂ列（名前）に書かれたものを貼り付ける
for i=3 to n
worksheets("入力").range("B"+CStr(i)).copy
worksheets("明細書元").select
activesheet.range("D"+CStr(22*(i-2)-17)).select
next
'D列（基本給）に書かれたものを貼り付ける
for i=3 to n
worksheets("入力").range("D"+CStr(i)).copy
worksheets("明細書元").select
activesheet.range("E"+CStr(22*(i-2)-13)).select
next
'E列（通勤手当）に書かれたものを貼り付ける
for i=3 to n
worksheets("入力").range("E"+CStr(i)).copy
worksheets("明細書元").select
activesheet.range("G"+CStr(22*(i-2)-13)).select
next
'Ｆ列（調整分）に書かれたものを貼り付ける
for i=3 to n
worksheets("入力").range("F"+CStr(i)).copy
worksheets("明細書元").select
activesheet.range("I"+CStr(22*(i-2)-13)).select
next
'Ｇ列（住民税）に書かれたものを貼り付ける
for i=3 to n
worksheets("明細書元").select
activesheet.range("D"+CStr(22*(i-2)-6)).value=worksheets("入力").range("G"+CStr(i)).value
next

---------------------------------------------------
貼り付けまでは行ったのですが
(1)基本給、通勤手当、調整分を計算する
やつのソースがわかりません。
ちなみにnとはn=Range("A65536").End(xlUp).Rowでやったもののnになります