アプリ版:「スタンプのみでお礼する」機能のリリースについて

いつもお世話になります。
納品書入力シート(sheet2)から振替伝票シート(Sheet11)にデータを保存し、同じシート内の振替伝当日当日データを入力し、そのデータをSheet13の現金出納帳(様式を4月から翌年3月まで作成)に月日ごとに転記しようとしています。4月のみ現金出納帳には現在のコードで転記できましたが、5月以降の出納帳への転記が出来ません。そこで4月のコードをコピーし4月のコードの次に貼付・修正して見ましたが、やはり上手く作動しません。どなたか教えて下さい。お願いします。
4月の現金出納帳には6行目~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

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

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

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

    「月毎に現金出納帳に転記するコードを教えて」の補足画像2
      補足日時:2022/01/28 19:00
  • 補足3です。
    全ての月表を添付出来そうにないので、切り取っています。

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

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

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

補足要求です。


1.下記①②のレイアウトがよくわかりません。
①振替伝票シート(Sheet11)
②Sheet13の現金出納帳(様式を4月から翌年3月まで作成)
画像で提示していただけませんでしょうか。

2.提示されたマクロは4月のコードであり、しかも、そのマクロは4月として、正しく動作している
ということでしょうか。
4月が6行目~34行目にデータを転記と書いていますが、提示されたマクロには
6行目~34行目に関する記述がないので、おかしいなと思った次第です。
    • good
    • 0
この回答へのお礼

有り難うございます。補足させて頂きました。

お礼日時:2022/01/28 18:58

こんばんは


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

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

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

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


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

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

説明不足で済みません。

お礼日時:2022/01/28 20:40

#2です。


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

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

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
この回答へのお礼

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

お礼日時:2022/01/28 20:21

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



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

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

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

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

有り難うございます。
5月以降の最初の行は繰越行に使っています。4月~6月まではあっています。7月からの最初の行と終了行は、つぎの様になります。7月:118~145、8月:155~182,9月:192~219、10月:229~256、11月:226~293,12月:303~330、1月:340~367、2月:377~404、3月:414~441
となります。

お礼日時:2022/01/28 22:32

>44行目→56行目に



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

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

4月が 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

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



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

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

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

お礼日時:2022/01/28 23:03

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

めぐみん_様 Goodです。


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

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

お礼日時:2022/01/29 10:17

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


>しかし、5月の行への転記箇所が12行下に転記されました。
>44行目→56行目に
もし、この事象が発生するなら、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

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