重要なお知らせ

「教えて! goo」は2025年9月17日(水)をもちまして、サービスを終了いたします。詳細はこちら＞

電子書籍の厳選無料作品が豊富！

マジレス希望

月毎に現金出納帳に転記するコードを教えて下さい。

解決済

  • 質問者：sanshaintosi
  • 質問日時：
  • 回答数：11件

いつもお世話になります。
納品書入力シート(sheet2)から振替伝票シート（Sheet11）にデータを保存し、同じシート内の振替伝当日当日データを入力し、そのデータをSheet13の現金出納帳（様式を４月から翌年３月まで作成）に月日ごとに転記しようとしています。４月のみ現金出納帳には現在のコードで転記できましたが、５月以降の出納帳への転記が出来ません。そこで４月のコードをコピーし4月のコードの次に貼付・修正して見ましたが、やはり上手く作動しません。どなたか教えて下さい。お願いします。
４月の現金出納帳には６行目～34行目にデータを、同様に5月は44行目～71行目までに、6月は81行目～108行目までに、以下省略・・・にデータを転記出来るよう作表してます。
コードは次のとおりです。
Public Sub 現金出納帳()
Dim sh13 As Worksheet
Dim sh11 As Worksheet
Dim maxrow As Long
Dim row As Long
Dim dicT As Object
Dim key As Variant
Set sh13 = Worksheets("現金出納帳")
Set sh11 = Worksheets("振替伝票")
Set dicT = CreateObject("Scripting.Dictionary")
maxrow = sh11.Cells(Rows.Count, "H").End(xlUp).row
'伝票番号を記憶
For row = 6 To maxrow
key = sh11.Cells(row, "H").Value
dicT(key) = row
Next
key = sh11.Cells(4, "AA").Value
If dicT.exists(key) = False Then
　MsgBox ("伝票番号=" & key & "は振替伝票にありません")
Exit Sub
End If

If sh11.Cells(15, "AP").Value = "" Then
　MsgBox ("合計が未表示です")
Exit Sub
End If
If sh11.Cells(5, "Q").Value = "" Then
MsgBox ("年が未表示です")
ElseIf sh11.Cells(5, "Q").Value > 2 Then
sh13.Cells(5, "B").Value = sh11.Cells(5, "Q").Value
Else
Exit Sub
End If

row = dicT(key)
sh13.Cells(row, "L").Value = sh11.Cells(7, "AA").Value '名前
sh13.Cells(row, "X").Value = sh11.Cells(15, "AP").Value '金額
sh13.Cells(row, "C").Value = sh11.Cells(5, "W").Value '日
sh13.Cells(row, "B").Value = sh11.Cells(5, "U").Value '月
sh13.Cells(row, "N").Value = sh11.Cells(19, "Z") '他店数
sh13.Cells(row, "M").Value = sh11.Cells(19, "X").Value '他
sh13.Cells(row, "O").Value = sh11.Cells(19, "AA").Value '店
sh13.Cells(row, "D").Value = sh11.Cells(7, "Z").Value '伝票番号
sh13.Cells(row, "E").Value = sh11.Cells(8, "Z").Value '伝票番号
sh13.Cells(row, "F").Value = sh11.Cells(9, "Z").Value '伝票番号
sh13.Cells(row, "G").Value = sh11.Cells(10, "Z").Value '伝票番号
sh13.Cells(row, "H").Value = sh11.Cells(11, "Z").Value '伝票番号
sh13.Cells(row, "I").Value = sh11.Cells(12, "Z").Value '伝票番号
sh13.Cells(row, "J").Value = sh11.Cells(13, "Z").Value '伝票番号
sh13.Cells(row, "K").Value = sh11.Cells(14, "Z").Value '伝票番号

MsgBox ("現金出納帳に転記します")

End Sub

質問者からの補足コメント

  • 補足いたします。
    １. >下記の①②のレイアウトがよくわかりません。
    ⇒別途に添付します。
    ２．>提示されたマクロは４月のコードであり、しかも、そのマクロは４月として、正しく動作してい　　　るということでしょうか。
    ⇒正しく作動しています。
    　　＞4月が６行目～34行目にデータを転記と書いていますが、提示されたマクロには６行目～34行目　に関する記述がないので、おかしいなと思った次第です。
    ⇒このコードは、まだ未完成で最終行まで参照するので、４月分の３４行目までは正しく転記しますが、添付図のとおり、５月分以降は区切りがあって、途中の行から始まります。なので、４月分のみです。

    「月毎に現金出納帳に転記するコードを教えて」の補足画像1
      補足日時：2022/01/28 18:57
    通報する

  • 補足２です。

    「月毎に現金出納帳に転記するコードを教えて」の補足画像2
      補足日時：2022/01/28 19:00
    通報する

  • 補足３です。
    全ての月表を添付出来そうにないので、切り取っています。

    「月毎に現金出納帳に転記するコードを教えて」の補足画像3
      補足日時：2022/01/28 19:03
    通報する

  • 補足します。

    「月毎に現金出納帳に転記するコードを教えて」の補足画像4
      補足日時：2022/01/28 19:07
    通報する
通報する

この質問への回答は締め切られました。

質問の本文を隠す

A 回答 (11件中1～10件)

参考程度に

No.4ベストアンサー

  • 回答者： Qchan1962
  • 回答日時：

＃２です。


ボタン登録などの問題もあると思いますので
あっているか不明な点がありますが、下記のような感じです。

あまり、定数で指定するのは良くないと思いますが
出来ている処理コードを条件を変えて使い回す方法で考えてみました。

Sub 現金出納帳()
Dim mRow As Long
If Not IsDate(Range("J2").Value) Then Exit Sub
Select Case Month(Range("J2").Value)
Case 4: mRow = 0
Case 5: mRow = 38
Case 6: mRow = 75
Case 7: mRow = 112
Case 8: mRow = 149
Case 9: mRow = 186
Case 10: mRow = 223
Case 11: mRow = 260
Case 12: mRow = 297
Case 1: mRow = 334
Case 2: mRow = 371
Case 3: mRow = 408
End Select
Call cashbook_main(mRow)
End Sub

Public Sub cashbook_main(mRow As Long)
Dim sh13 As Worksheet
Dim sh11 As Worksheet
Dim maxrow As Long
Dim row As Long
Dim dicT As Object
Dim key As Variant
Set sh13 = Worksheets("現金出納帳")
Set sh11 = Worksheets("振替伝票")
Set dicT = CreateObject("Scripting.Dictionary")
maxrow = sh11.Cells(Rows.Count, "H").End(xlUp).row
'伝票番号を記憶
For row = 6 To maxrow
key = sh11.Cells(row, "H").Value
dicT(key) = row
Next
key = sh11.Cells(4, "AA").Value
If dicT.exists(key) = False Then
MsgBox ("伝票番号=" & key & "は振替伝票にありません")
Exit Sub
End If

If sh11.Cells(15, "AP").Value = "" Then
MsgBox ("合計が未表示です")
Exit Sub
End If
If sh11.Cells(5, "Q").Value = "" Then
MsgBox ("年が未表示です")
ElseIf sh11.Cells(5, "Q").Value > 2 Then
sh13.Cells(5, "B").Value = sh11.Cells(5, "Q").Value
Else
Exit Sub
End If
row = dicT(key)
sh13.Cells(row + mRow, "L").Value = sh11.Cells(7, "AA").Value '名前
sh13.Cells(row + mRow, "X").Value = sh11.Cells(15, "AP").Value '金額
sh13.Cells(row + mRow, "C").Value = sh11.Cells(5, "W").Value '日
sh13.Cells(row + mRow, "B").Value = sh11.Cells(5, "U").Value '月
sh13.Cells(row + mRow, "N").Value = sh11.Cells(19, "Z").Value '他店数
sh13.Cells(row + mRow, "M").Value = sh11.Cells(19, "X").Value '他
sh13.Cells(row + mRow, "O").Value = sh11.Cells(19, "AA").Value '店
sh13.Cells(row + mRow, "D").Value = sh11.Cells(7, "Z").Value '伝票番号
sh13.Cells(row + mRow, "E").Value = sh11.Cells(8, "Z").Value '伝票番号
sh13.Cells(row + mRow, "F").Value = sh11.Cells(9, "Z").Value '伝票番号
sh13.Cells(row + mRow, "G").Value = sh11.Cells(10, "Z").Value '伝票番号
sh13.Cells(row + mRow, "H").Value = sh11.Cells(11, "Z").Value '伝票番号
sh13.Cells(row + mRow, "I").Value = sh11.Cells(12, "Z").Value '伝票番号
sh13.Cells(row + mRow, "J").Value = sh11.Cells(13, "Z").Value '伝票番号
sh13.Cells(row + mRow, "K").Value = sh11.Cells(14, "Z").Value '伝票番号

MsgBox ("現金出納帳に転記します")

End Sub

コピペ追加なので間違いがあるかも知れません。

本当は、上の行（先月の最終行+10行）みたいに出力セルを設定するのが
良いのではないかと思います（可変になります）
間の10行は月が替わりの、始めの実行で見出しなどを出力します）
    • good
    • 0
    • 件
通報する
この回答へのお礼

有り難うございます。転記は出納帳に正しく転記されます。
しかし、５月の行への転記箇所が１２行下に転記されました。
４４行目→５６行目に
修正箇所を教えて頂けたら助かります。

通報する
お礼日時：2022/01/28 20:21

No.11

key = sh11.Cells(4, "AA").Value


If dicT.exists(key) = False Then
　MsgBox ("伝票番号=" & key & "は振替伝票にありません")
Exit Sub
End If

この部分も

With sh11
If WorksheetFunction.CountIf(.Range("H:H"), .Range("AA4").Value) = 0 Then
MsgBox ("伝票番号=" & .Range("AA4").Value & "は振替伝票にありません")
Exit Sub
End If
End With

ワークシート関数のCountIfで判断させます。
また他のExit Subに繋がるIf文も纏めて

＞'伝票番号を記憶

より前に記載すれば無駄にループ処理を先にしなくて済むのでは？
だってDictionaryとは直接関係ないですよね。


★変数名：row は修正して下さい。
例えばセルＡ１の行数を求めようとして
Range("A1"). と打ち込んだ後に Row が選択候補にあがっても
Range("A1").row
と変換されるようになっちゃいます。
入門編で使用禁止の予約語として型宣言の時に注意を書いている参考書はあるものです。

ちなみに空いている所でSub Row() と打ち込んでエンター。
End Sub が出れば直りますけどね。
そしたらこの２行は削除して構いません。
    • good
    • 0
    • 件
通報する
この回答へのお礼

有り難うございます。追加修正して試行してみます。なお、Qchan1962様のコードのｍRows=数字を修正したら月毎の出納帳に転記できました。

通報する
お礼日時：2022/01/29 10:12

No.10

月は振替伝票のU5のセルの値を使用します。


>しかし、５月の行への転記箇所が１２行下に転記されました。
>４４行目→５６行目に
もし、この事象が発生するなら、No4の方と考え方は同じなので、
そもそも、振替伝票シートの考え方に齟齬があるということになります。
もし、この事象が発生するなら、その旨、補足してください。
--------------------------------------------
Public Sub 現金出納帳()
Dim sh13 As Worksheet
Dim sh11 As Worksheet
Dim maxrow As Long
Dim row As Long
Dim dicT As Object
Dim key As Variant
Dim mm As Long
Dim start_row As Long
Set sh13 = Worksheets("現金出納帳")
Set sh11 = Worksheets("振替伝票")
Set dicT = CreateObject("Scripting.Dictionary")
maxrow = sh11.Cells(Rows.Count, "H").End(xlUp).row
'伝票番号を記憶
For row = 6 To maxrow
key = sh11.Cells(row, "H").Value
dicT(key) = row
Next
key = sh11.Cells(4, "AA").Value
If dicT.exists(key) = False Then
MsgBox ("伝票番号=" & key & "は振替伝票にありません")
Exit Sub
End If

If sh11.Cells(15, "AP").Value = "" Then
MsgBox ("合計が未表示です")
Exit Sub
End If
If sh11.Cells(5, "Q").Value = "" Then
MsgBox ("年が未表示です")
ElseIf sh11.Cells(5, "Q").Value > 2 Then
sh13.Cells(5, "B").Value = sh11.Cells(5, "Q").Value
Else
Exit Sub
End If

mm = sh11.Cells(5, "U").Value
If mm < 1 Or mm > 12 Then Exit Sub
start_row = GetStartRow(mm)
row = dicT(key)
row = row + start_row - 6
sh13.Cells(row, "L").Value = sh11.Cells(7, "AA").Value '名前
sh13.Cells(row, "X").Value = sh11.Cells(15, "AP").Value '金額
sh13.Cells(row, "C").Value = sh11.Cells(5, "W").Value '日
sh13.Cells(row, "B").Value = sh11.Cells(5, "U").Value '月
sh13.Cells(row, "N").Value = sh11.Cells(19, "Z") '他店数
sh13.Cells(row, "M").Value = sh11.Cells(19, "X").Value '他
sh13.Cells(row, "O").Value = sh11.Cells(19, "AA").Value '店
sh13.Cells(row, "D").Value = sh11.Cells(7, "Z").Value '伝票番号
sh13.Cells(row, "E").Value = sh11.Cells(8, "Z").Value '伝票番号
sh13.Cells(row, "F").Value = sh11.Cells(9, "Z").Value '伝票番号
sh13.Cells(row, "G").Value = sh11.Cells(10, "Z").Value '伝票番号
sh13.Cells(row, "H").Value = sh11.Cells(11, "Z").Value '伝票番号
sh13.Cells(row, "I").Value = sh11.Cells(12, "Z").Value '伝票番号
sh13.Cells(row, "J").Value = sh11.Cells(13, "Z").Value '伝票番号
sh13.Cells(row, "K").Value = sh11.Cells(14, "Z").Value '伝票番号

MsgBox ("現金出納帳に転記します")

End Sub

Private Function GetStartRow(ByVal month As Long)
If month < 4 Then month = month + 12
GetStartRow = (month - 4) * 37 + 6
If month > 4 Then GetStartRow = GetStartRow + 1
End Function
    • good
    • 0
    • 件
通報する
この回答へのお礼

遅くまでご教授頂き有り難うございます。試行してみます。

通報する
お礼日時：2022/01/29 10:02

No.9

  • 回答者： Qchan1962
  • 回答日時：

めぐみん_様　Goodです。


画像ほぼ見てなかった。。
    • good
    • 0
    • 件
通報する
この回答へのお礼

ご教授有り難うございました。ｍRows=数字を修正したら月毎の出納帳に転記できました。まだ一連の作業が完成していませんので、また宜しくお願いします。

通報する
お礼日時：2022/01/29 10:17

No.8

No.7です。



あと規則性のある

sh13.Cells(row, "D").Value = sh11.Cells(7, "Z").Value '伝票番号
sh13.Cells(row, "E").Value = sh11.Cells(8, "Z").Value '伝票番号
sh13.Cells(row, "F").Value = sh11.Cells(9, "Z").Value '伝票番号
sh13.Cells(row, "G").Value = sh11.Cells(10, "Z").Value '伝票番号
sh13.Cells(row, "H").Value = sh11.Cells(11, "Z").Value '伝票番号
sh13.Cells(row, "I").Value = sh11.Cells(12, "Z").Value '伝票番号
sh13.Cells(row, "J").Value = sh11.Cells(13, "Z").Value '伝票番号
sh13.Cells(row, "K").Value = sh11.Cells(14, "Z").Value '伝票番号

ここは

With Application
sh13.Cells(row, "D").Resize(, 8).Value = .Transpose(sh11Range("Z7:Z14").Value) '伝票番号
End With

こんな感じで纏めても宜しいのではないかなと。
ただし変数名：row は予約語になるので本来使用すべきものではないですよ。
あと実際どう言う扱い（行の指定方法）になるかはお任せします。
    • good
    • 1
    • 件
通報する
この回答へのお礼

いつも有り難うございます。すっきりしました。

通報する
お礼日時：2022/01/29 09:57

No.7

老眼ジジィの見間違いなら気にしないでスル～してください。



何月であるのかって行数がどこから始まるのかより、画像からするとＡＩ：ＡＯの結合セルにある『○月』から４行下が起点となるのではなかろうかと感じますけど？
その○月を検索して行を求め＋４が書き込みたい位置なのではと初級者ジジィは思えましたが違いましたかね？

それとも実行前には値として打ち込まれていないのかな？
    • good
    • 1
    • 件
通報する
この回答へのお礼

有り難うございます。
確かにそうです。４月は起点が６行目となります。
この月セルは手入力しています。コードの中には使っていないので・・・。

通報する
お礼日時：2022/01/28 23:03

No.6

  • 回答者： Qchan1962
  • 回答日時：

>４４行目→５６行目に



Case 5: mRow = 38 と38を投げて　56　と言う事は
row + mRow　なので　row = dicT(key)　は　18と言う事になります

Case 5: mRow = 26　とすれば良い事になりますが、

４月が　row = dicT(key)　6
5月は　row = dicT(key)　18
6月は・・？　18？
このrowの値に規則があるのなら、その数値を求める式を
Sub 現金出納帳()内で行い　mRowに代入して
cashbook_mainの引数に与えれば良い事になります。

規則性が無い場合は、row = dicT(key)が何の数なのかを精査して
sh11.Cells(Rows.Count, "H").End(xlUp).row　や　Countなどで
取得可能であれば　取得しターゲット行番号の差分をmRowに代入すれば良い事になると思います。

気力が無いのでデモ環境を制作、検証するのは出来ません
がんばってデバッグしてみてください。
    • good
    • 0
    • 件
通報する
この回答へのお礼

助かりました

有り難うございました。デバックで頑張って見ます。

通報する
お礼日時：2022/01/28 22:36

No.5

>４月の現金出納帳には６行目～34行目にデータを、同様に5月は44行目～71行目までに、6月は81行目～108行目までに、以下省略・・・にデータを転記出来るよう作表してます。



提示された月ごとの開始行と終了行を整理すると、月毎の
1か月の行数及び次の魁夷行までのスパンは全て一致するはずですが、
一致しません。

１か月の行数が不一致
　　　開始行　終了行　1か月の行数
４月　6 　　　34　　　29(34-6+1)
５月　44　　　71　　　28(71-44+1)
６月　81　　　108 　　28(108-81+1)

次の開始行までのスパンが不一致
　　　開始行　次の開始行までのスパン
４月　6 　　　37(44-6-1)
５月　44　　　36(81-44-1)
６月　81　　　

本当にこの４月から６月の開始行と終了行はこれであってますか。
もし、あっているなら、規則性がないので、
7月から３月の分の開始行と終了行も提示していただけませんでしょうか。
規則性がないので４月から３月の全ての月の開始行と終了行をマクロ内に
抱え込みます。
    • good
    • 0
    • 件
通報する
この回答へのお礼

有り難うございます。
５月以降の最初の行は繰越行に使っています。４月～６月まではあっています。７月からの最初の行と終了行は、つぎの様になります。７月：１１８～１４５、８月：１５５～１８２，９月：１９２～２１９、１０月：２２９～２５６、１１月：２２６～２９３，１２月：３０３～３３０、１月：３４０～３６７、２月：３７７～４０４、３月：４１４～４４１
となります。

通報する
お礼日時：2022/01/28 22:32

No.3

補足ありがとうございました。


提示された画像とシート名の対応がよくわかりません。
①補足の画像（黄色のセルのある画像）のシート名はなんですか。
②補足２の画像のシート名はなんですか。
③補足３の画像のシート名はなんですか。
又、補足３の画像の列の位置がわかりません。
30,31,32,33・・・と縦に文字が並んでいるのは何列でしょうか。（A列、B列等の列です）
    • good
    • 0
    • 件
通報する
この回答へのお礼

有り難うございます。
画像の件ですが、
＞振替伝票シート（Sheet11)で、左の表がデータで、右の表が振替伝票の入力シートです。
＞補足２は金銭出納帳（Sheet13)で、４月の表です。
＞補足３は３月の金銭出納帳で上半分、下半分は次の補足画像です。
＞A列の数字は作業中での意味の無い数字です。B列は月、C列は日です。

説明不足で済みません。

通報する
お礼日時：2022/01/28 20:40

参考程度に

No.2

  • 回答者： Qchan1962
  • 回答日時：

こんばんは


＞４月のみ現金出納帳には現在のコードで転記できましたが、５月以降の出納帳への転記が出来ません。
コードの内容はよく見ていないのですが、

４月が出来、出力先が変わるだけで同じなら、
出力先を変数にして

Public Sub 現金出納帳(mRow as long) などとして

Dim mRow As Long
Select Case XXXX月表記取得
Case "4月": mRow = 6
Case "5月": mRow = 44
Case "6月": mRow = 81
End Select
Call 現金出納帳(mRow)
みたいに呼べば良いのではないかと思います。
行+mRow　で使うでしょうから、数字は実際の必要な値に
    • good
    • 0
    • 件
通報する
この回答へのお礼

いつも有り難うございます。試行します。

通報する
お礼日時：2022/01/28 19:13

お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう！

Q質問する（無料）

関連するカテゴリからQ&Aを探す

ページトップページトップ

Q質問する（無料）

デイリーランキングこのカテゴリの人気デイリーQ&Aランキング

マンスリーランキングこのカテゴリの人気マンスリーQ&Aランキング

おすすめ情報