VBA初心者請求書作成 for next 長いこと取り組んでうまくいかず、まいってます。

Question

Sheets("リスト")Sheets("原本")を使い作成してます。
色々作成しましたが。。。


Sub 請求書作成()
Dim n, i As Long

n = Worksheets("リスト").Cells(Rows.Count, "A").End(xlUp).Row
 For i = 2 To n
Worksheets("原本").Copy After:=Worksheets(Worksheets.Count)
       With ActiveSheet
       .Name = 氏名.Value
'2行目を請求書ひな形に転記 氏名
       .Cells(3, 5).Value = Sheets("リスト").Cells(i, 1).Value
       .Cells(23, 5).Value = Sheets("リスト").Cells(i, 1).Value
       .Cells(45, 5).Value = Sheets("　リスト").Cells(i, 1).Value
       .Cells(63, 5).Value = Sheets("リスト").Cells(i, 1).Value
'2行目を請求書ひな形に転記 合計金額
       .Cells(5, 6).Value = Sheets("リスト").Cells(i, 5).Value
       .Cells(25, 6).Value = Sheets("リスト").Cells(i, 5).Value
       .Cells(45, 6).Value = Sheets("リスト").Cells(i, 5).Value
Sheets("原本").Cells(65, 65).Value = Sheets("リスト").Cells(i, 5).Value
'2行目を請求書ひな形に転記　消費税欄
        .Cells(13, 6).Value = Sheets("リスト").Cells(i, 5).Value
        .Cells(33, 6).Value = Sheets("リスト").Cells(i, 5).Value
        .Cells(53, 6).Value = Sheets("リスト").Cells(i, 5).Value
        .Cells(73, 6).Value = Sheets("リスト").Cells(i, 5).Value
'2行目を請求書ひな形に転記   入所日
        .Cells(7, 11).Value = Sheets("リスト").Cells(i, 2).Value
        .Cells(27, 11).Value = Sheets("リスト").Cells(i, 2).Value
        .Cells(47, 11).Value = Sheets("リスト").Cells(i, 2).Value
        .Cells(67, 11).Value = Sheets("リスト").Cells(i, 2).Value
'2行目を請求書ひな形に転記   退所日
        .Cells(8, 11).Value = Sheets("リスト").Cells(i, 3).Value
        .Cells(28, 11).Value = Sheets("リスト").Cells(i, 3).Value
        .Cells(48, 11).Value = Sheets("リスト").Cells(i, 3).Value
.Cells(68, 11).Value = Sheets("リスト").Cells(i, 3).Value
'2行目を請求書ひな形に転記   日数
        .Cells(9, 11).Value = Sheets("リスト").Cells(i, 4).Value
        .Cells(29, 11).Value = Sheets("リスト").Cells(i, 4).Value
        .Cells(49, 11).Value = Sheets("リスト").Cells(i, 4).Value
        .Cells(69, 11).Value = Sheets("リスト").Cells(i, 4).Value
End With

i = i + 1

Next
End Sub

Qchan1962 · Accepted Answer

こんにちは、
＞.Name = Sheets("リスト").Cells(i, 1).Value
＞これでできましたが　他にどのようなコードがありますでしょうか？

ご質問のコードで問題を感じるのは、
.Name = 氏名.Value　と　i = i + 1　です。

.Name = Sheets("リスト").Cells(i, 1).Value　Sheets("リスト").Cells(i, 1).Valueは氏名とされているので良いと思いますが
シート名を別に付けたい名前があるのであれば、リストシートに対応する列を作り新たに目的の値を入力するようにすればよいかと
（リストシートの行の値ですべてが決まってくるので、　1行ずつ実行されると言う意味です）

同じブックにシートを追加していくVBAなので、おそらく同名シートが既に存在しますとエラーがいつか発生すると思います。
#4の様にする方法もありますが、、、ブックのシートが増えていくのは、どうでしょうか？

For j = 13 To 73 Step 20
.Cells(j, 6).Value = Sheets("リスト").Cells(i, 5).Value
Next
ループで入力して行きたいのでしょうか、入力範囲が変動するのであれば仕方ないですが、
出来るだけ一回で書き込める場合は、ループを使わない方が良いと思います。
.Range("F13,F33,F53,F73").Value Excelぽくて嫌なのかも知れませんが

ご質問の書き込み位置が合っているとして、原本シートが存在するBookに標準モジュールを追加して
下記をコピペ試してください。（ご質問のコードのみを考察しています。関連処理がある場合は、要修正）
少ないリストで試してみてください。

Sub Sample()
Dim i As Long, n As Long
Dim Wb As Workbook, newBookName As String
　　Set Wb = ThisWorkbook
　　n = 1　　　　　　　　　　'シートカウンタ
　　On Error Resume Next　　 'うまく動かない場合は、コメントブロックしてデバッグしてください
　　Application.DisplayAlerts = False
　　Application.ScreenUpdating = False
　　With Workbooks.Add　　　 '新規ブック作成
　　　　For i = 2 To Wb.Worksheets("リスト").Cells(Rows.Count, "A").End(xlUp).Row
　　　　　　If n <= ActiveWorkbook.Worksheets.Count Then
　　　　　　　　Wb.Worksheets("原本").Cells.Copy .Worksheets(n).Cells　　'新規シートにコピー
　　　　　　Else
　　　　　　　　Wb.Worksheets("原本").Copy , .Worksheets(.Worksheets.Count)　　'新規シートを挿入
　　　　　　End If
　　　　　　With ActiveSheet
　　　　　　　　.Name = Wb.Sheets("リスト").Cells(i, 1).Value　　'新規シートのシート名を設定
　　　　　　　　.Range("E3,E23,E45,E63").Value = Wb.Sheets("リスト").Cells(i, 1).Value　　'請求書ひな形に転記 氏名
　　　　　　　　.Range("F5,F25,F45").Value = Wb.Sheets("リスト").Cells(i, 5).Value　　'請求書ひな形に転記 合計金額
　　　　　　　　.Range("F13,F33,F53,F73").Value = Wb.Sheets("リスト").Cells(i, 5).Value　　' 請求書ひな形に転記　消費税欄　5?合計金額と同じ？
　　　　　　　　.Range("K7,K27,K47,K67").Value = Wb.Sheets("リスト").Cells(i, 2).Value　　'請求書ひな形に転記 入所日
　　　　　　　　.Range("K8,K28,K48,K68").Value = Wb.Sheets("リスト").Cells(i, 3).Value　　'請求書ひな形に転記 退所日
　　　　　　　　.Range("K9,K29,K49,K69").Value = Wb.Sheets("リスト").Cells(i, 4).Value　　'請求書ひな形に転記 日数
　　　　　　End With
　　　　　　n = n + 1
　　　　Next i
　　　　newBookName = Format(Date, "yyyymmdd") & "請求書"　　'新規ブック名　同名ファイルがあったら上書きされるので注意
　　　　.SaveAs _
　　　　　　　　Filename:=ThisWorkbook.Path & "\" & newBookName & ".xlsx", _
　　　　　　　　FileFormat:=xlOpenXMLWorkbook
　　　　.Close
　　End With
　　Application.ScreenUpdating = True
　　Application.DisplayAlerts = True
End Sub

Qchan1962 · Answer

＞上記のコメントが気になりました。私がこのコードで請求書を作成するシート数は、毎月100枚から150枚のつもりしたので。。。無理がある作業でしょうか？
当面は大丈夫かと思いますが、毎月100枚、年間1200枚、もし同じブックに1請求書1シートなら問題あるのは想像できますね。
仮に1シートで1200の請求書を作るとしてもどんどんファイルは重たくなって行くと問題が発生するかもしれません。1年度ごとに別ブックに複製すれば良いと思いますが。

私的にExcel　VBAで帳票類を作る場合、出来るだけデータ化した方が良いように思います。

表題のご質問に関しては、目途が立ったようですので取り敢えずこの辺で。

Qchan1962 · Answer

こんばんは、
＞色々調べたところ左上のセルを使うことで解決しました
良かったです。
＞方眼利用しない方が賢明ですか？
仕様や好みにより仕方ないケースもあるのかと思います。
私的には、方眼仕様を行った事はありません。
Excelでシートを数十シート作る事やセルの結合などもほぼ、行いませんね。
昔、興味本位で色々やりましたが、目的と方法の合理性を見出す事が出来ず、やめました。

良いかどうかと言う事を提言できませんが、せっかくある機能やアイディアなので使う事は問題ないと思います。
ただ、当然使いこなすスキルも必要になるのではないかと思いますので、私は、避けていますね。

Qchan1962 · Answer

>これは、シートの名前を別に付けたいときは、新たに列を作成、そこを指定してコードを作成すれば良いということですよね。()内の意味がよく分からないのですが教えてください。
その通りですが、同じ名前を付ける事は出来ませんので注意が必要です。

サンプルは、
.Name = Sheets("リスト").Cells(i, 1).Valueでシート名を設定しています。
ループ処理は、リストシートのA列の最終行まで繰り返されます。1周目はFor i = 2 Toなので2行目からです。
ブックの作成と保存以外のメイン処理は、このループの中で実行されているので、行単位で実行されると言う意味です。

シート名の場合、
Cells(i, 1).Valueは、iが2の時　A2セルの値を示します。これが、ループでA2,A3,A4、、、と最終行まで続きます。
つまり、新しく作成されたシート名は、A列の変動する行の値になります。
新たに付けたい名前の列を作り、Sheets("リスト").Cells(i, "A").Value　のAを変えれば良いです。Cells(i, "A").Value　と　Cells(i, 1).Value は同じ
他にも色々出来ると思います。

ついでに、
If n <= ActiveWorkbook.Worksheets.Count Then　’Worksheets.Countは、新規ブックのシートの数
　　　　　　　　Wb.Worksheets("原本").Cells.Copy .Worksheets(n).Cells　　'新規（既存）シートにコピー　(n)はシートのインデックス
　　　　　　Else
　　　　　　　　Wb.Worksheets("原本").Copy , .Worksheets(.Worksheets.Count)　　'コピーシートを新規に挿入（一番右側に）
　　　　　　End If

上のコードは、新規作成されたブックのシート数がユーザーによって異なる場合があるのでシートの数を確認しながら、
既存シートにコピーするか、コピーシートを挿入するか分けています。

参考まで

めぐみん_ · Answer

やっぱ初級レベルでは役に立たないって広がっているのですね。
ここはベテラン回答者にお任せが宜しいのでしょう。
さすがにクラスモジュール・ＡＰＩ・自作ＤＬＬ作成を使いこなせるレベルからは程遠いからなぁ。

めぐみん_ · Answer

気になった点で。

補足にある

＞コメントしてるひな形とはSheets("原本")のことです。

は正確には違いますよね？
Sheets("原本")を複製したシートを指している。
けどそのシートのコピペで止まるってなら、このコードが書かれているＢｏｏｋとは別のＢｏｏｋではないですか？
例えば原本.xlsxとか？

と初級者は思い違いを起こしてしまう・・・

Qchan1962 · Answer

こんにちは、
＞Worksheets("原本").Copy After:=Worksheets(Worksheets.Count)
＞インデックスが有効範囲にありませんとでてしまいます
このエラーは、ループの1周目から出ますか？
VBAが実行されているブックに原本と言う名前のシートがあれば、問題ないと思います。
他のブックからコピーするならブックを明示しましょう。
また、実際のシート名に半角スペースなどが入っていないか確認してください。

＞.Name =Sheets("リスト") 氏名.Value
ごめんなさい、このコードで実行されるとは思えません。
何の値を指しているのですか？
セルの名前を参照するなら、.Name = Sheets("リスト").Range("氏名").Value　こんな形です。
また、氏名.Valueにインデックスがないので2度目のループで既に同名が～とエラーになるはずですが、どうでしょう？

＞Sheets("原本").Cells(65, 65).Value = Sheets("リスト").Cells(i, 5).Value
ループの中にありますが、リストの最後が最終的に入力されるだけです。

＃４では、金額と言う項目から推測して合計金額に変えましたが、何を意味しているのでしょうか？

Qchan1962 · Answer

こんにちは、補足を読みました。
補足の内容とコードの内容は一致していません。
示されているプログラムの流れですと、
n = Worksheets("リスト").Cells(Rows.Count, "A").End(xlUp).Row
シート名　リストのA列の最終行を変数ｎに代入
For i = 2 To n
2行目から上記リストA列最終行まで繰り返し処理
Worksheets("原本").Copy After:=Worksheets(Worksheets.Count)
シート名原本　シートをコピーして一番右側に複製する
With ActiveSheet
複製したシートに対して実行する
.Name = 氏名.Value
複製したシート名を氏名.Valueにする（氏名オブジェクトは設定されていないのでエラー）何を指しているか説明してください。
以下
.Cells(hoge, huga).Value = piyo などは、新規作成（複製）されたシートに対して値を書き込んでいます。

'2行目を請求書ひな形に転記 合計金額
'2行目を請求書ひな形に転記　消費税欄
項目が違うのに同じ場所を参照しています。これで合っているのでしょうか？

＞転記コードが4行ずつあるのは同じ書式のもの4枚分です。
＞(領収書(控)、領収書、請求書、請求書(控））
同じシートだとコードは言っていますが、違うシートですか？

＞リストの情報を1行ずつ原本に転記していき、コピーしたsheetのインデックス名にリストの氏名を入れていくということです。

値を入れて行く前にコピーされていますが、示されている
n = Worksheets("リスト").Cells(Rows.Count, "A").End(xlUp).Row
For i = 2 To n
Worksheets("原本").Copy After:=Worksheets(Worksheets.Count)
の前にもコードがあるのでしょうか？

私の理解力が無いのかもしれませんが、益々分からなくなって来ました。

＃４のコードはご質問のコードをまとめたものです。
シート名　原本とリストがある事が条件になります。
リストを1,2行作って実行してみてください。

＞for next 長いこと取り組んでうまくいかず

.Cells(13, 6).Value = Sheets("リスト").Cells(i, 5).Value
.Cells(33, 6).Value = Sheets("リスト").Cells(i, 5).Value
.Cells(53, 6).Value = Sheets("リスト").Cells(i, 5).Value
.Cells(73, 6).Value = Sheets("リスト").Cells(i, 5).Value
これをforで回したいと言う事でしょうか？
ループで処理しなくても下記で良いのですが、
.Range("F13,F33,F53,F73").Value = Sheets("リスト").Cells(i, 5).Value

中身、処理は違いますが下記でも結果は同じです
for j = 13 to 73 step 20
.Cells(j, 6).Value = Sheets("リスト").Cells(i, 5).Value
next

めぐみん_ · Answer

＞とまってしまいます。

とまると言う現象はわかりますが『どうして止まったのか？』そのエラー内容が表示されるならその情報が重要ですよ。
憶測でいけば『原本』と言うシートがそのＢｏｏｋ内に存在しなく、実は別のＢｏｏｋだったとも受け取れてしまいますし。

Qchan1962 · Answer

#2です。示されているコードを纏めてみました。
理解できない部分は、想定で書き替えました。コードは、リストシート2行目から最後の行まで1行ずつ繰り返されます。
ご質問を明確に提示してみてはいかがでしょう。

Sub 請求書作成()
Dim i As Long, n As Long
　　For i = 2 To Worksheets("リスト").Cells(Rows.Count, "A").End(xlUp).Row
　　　　Worksheets("原本").Copy After:=Worksheets(Worksheets.Count)
　　　　With ActiveSheet
　　　　　　.Name = Format(Date, "yymmdd") & Sheets("リスト").Cells(i, 1).Value
　　'請求書ひな形に転記 氏名
　　　　　　.Range("E3,E23,E45,E63").Value = Sheets("リスト").Cells(i, 1).Value
　　' 合計金額
　　　　　　.Range("F5,F25,F45").Value = Sheets("リスト").Cells(i, 5).Value
　　'　消費税欄
　　　　　　.Range("F13,F33,F53,F73").Value = Sheets("リスト").Cells(i, 6).Value　　'5?　合計金額と同じ？解らないけどリストシートF列で
　　' 入所日
　　　　　　.Range("K7,K27,K47,K67").Value = Sheets("リスト").Cells(i, 2).Value
　　' 退所日
　　　　　　.Range("K8,K28,K48,K68").Value = Sheets("リスト").Cells(i, 3).Value
　　' 日数
　　　　　　.Range("K9,K29,K49,K69").Value = Sheets("リスト").Cells(i, 4).Value
　　　　End With
　　　　n = n + Sheets("リスト").Cells(i, 5).Value　　'発行した合計金額を合算する
　　Next
　　'原本のBM65セルに書き込む？
　　Sheets("原本").Cells(65, 65).Value = n　　'n=発行した合計金額
End Sub

変数　n　は不要なので違う使い方に割り当てました。

全体としては、新規シートを作成するなら、新規ブックを作成した方が良いかもです。

VBA初心者 請求書作成 for next 長いこと取り組んでうまくいかず、まいってます。

こんにちは、

＞上記のコメントが気になりました。

こんばんは、

>これは、シートの名前を別に付けたいときは、新たに列を作成、そこを指定してコードを作成すれば良いということですよね。

やっぱ初級レベルでは役に立たないって広がっているのですね。

気になった点で。

こんにちは、

こんにちは、補足を読みました。

＞とまってしまいます。

#2です。

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

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

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

VBA初心者請求書作成 for next 長いこと取り組んでうまくいかず、まいってます。