ネットが遅くてイライラしてない!?

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

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

  • うーん・・・

    お返事ありがとうございます。私の説明不足でした。
    コード内に、コメントしてるひな形とはSheets("原本")のことです。
    転記コードが4行ずつあるのは同じ書式のもの4枚分です。
    (領収書(控)、領収書、請求書、請求書(控))
    リストの情報を1行ずつ原本に転記していき、コピーしたsheetのインデックス名にリストの氏名を入れていくということです。Worksheets("原本").Copy After:=Worksheets(Worksheets.Count) でとまってしまいます。
    よろしくお願いします。

      補足日時:2020/07/03 00:28
  • うーん・・・

    返信ありがとうございます
    >複製したシート名を氏名.Valueに...何を指しているか説明してください。
    .Name =Sheets("リスト") 氏名.Value
    です
    >項目が違うのに同じ....これで合っているのでしょうか?
    矛盾してますがあってます
    >同じシートだとコードは言って...、違うシートですか?
    同じシートです
    >値を入れて行く前にコピーされていますが、示され....
    >同じシートだとコードは言っていますが違うシート?
    前回の補足がまちがいで原本を先にコピーしてから作りこんでいこうと思いました
    同じシートです
    >ループで処理しなくても下記、..
    凄い!納得です
    Worksheets("原本").Copy After:=Worksheets(Worksheets.Count)
    インデックスが有効範囲にありませんとでてしまいます
    初心者でお手数おかけします宜しくお願いします

    No.6の回答に寄せられた補足コメントです。 補足日時:2020/07/05 11:48
  • うーん・・・

    >また、実際の...確認してください
    VBEのVBA Project名が違う所で作成していましたお恥ずかしい
    >何の値を指しているのですか?
    シートのインデックスにリストの氏名をいれたっかたのですが、
    >氏名.Valueにインデ..2度目...が、どうでしょう?
    エラーになりました
    Dim 氏名 As Integer
    .Name = Sheets("リスト").Cells(i, 1).Value
    これでできましたが 他にどのようなコードがありますでしょうか?
    >#4では金額と言う...何を意味でしょうか?
    これは間違って書いてしまいました
    > ループで処理しなくても下記で良いのですが、
    For j = 13 To 73 Step 20
    .Cells(j, 6).Value = Sheets("リスト").Cells(i, 5).Value
    Next
    今 これで作成してます

    No.7の回答に寄せられた補足コメントです。 補足日時:2020/07/05 19:03
  • うれしい

    返信、遅くなりました。

    新ワークブックに請求書ができました。作成中に、イメージもしましたが、そもそも、自分の力量ではなかなか、と諦めのところがありましたので、VERY感謝です。
    >シート名を別に付.....(リストシートの行の値ですべてが決まってくるので、1行ずつ実行されると言う意味です) 
    これは、シートの名前を別に付けたいときは、新たに列を作成、そこを指定してコードを作成すれば良いということですよね。()内の意味がよく分からないのですが教えてください。

    No.10の回答に寄せられた補足コメントです。 補足日時:2020/07/09 13:15
  • うーん・・・

    いつも丁寧な返信ありがとうございます
    >On Error Resume Next 'うまく動かない場....
    > Application.DisplayAlerts = False
    >Application.ScreenUpdating = False
    >Application.ScreenUpdating = True
    > Application.DisplayAlerts = True
    は初めて使います少し調べて勉強になりましたが長いコードの時にはすごく有効ということですね
    原本の作成ですがきれいに方眼使用再作成セル結合にしましたが値が入らず(-_-;)色々調べたところ左上のセルを使うことで解決しました方眼利用しない方が賢明ですか?

    もう1点コードを加えた箇所ができ文字数オーバーでした再投稿します
    よかったら又よろしくお願いします

    No.11の回答に寄せられた補足コメントです。 補足日時:2020/07/12 16:52
  • うーん・・・

    返信ありがとうございます。
    >Excelでシートを数十シート作る事やセルの結合などもほぼ、行いませんね。
    上記のコメントが気になりました。私がこのコードで請求書を作成するシート数は、毎月100枚から150枚のつもりしたので。。。無理がある作業でしょうか?

    >.......目的と方法の合理性を見出す事が出来ず、やめました。
    方眼利用や、セルの結合、後々問題が起きそうなので、私もなるべく避けていくことにします。

    No.12の回答に寄せられた補足コメントです。 補足日時:2020/07/13 23:48

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

こんにちは、


>.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
この回答への補足あり
    • good
    • 0

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

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

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

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

こんばんは、


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

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

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

()内の意味がよく分からないのですが教えてください。
その通りですが、同じ名前を付ける事は出来ませんので注意が必要です。

サンプルは、
.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

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

参考まで
この回答への補足あり
    • good
    • 0

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


ここはベテラン回答者にお任せが宜しいのでしょう。
さすがにクラスモジュール・API・自作DLL作成を使いこなせるレベルからは程遠いからなぁ。
    • good
    • 0

気になった点で。



補足にある

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

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

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

こんにちは、


>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
ループの中にありますが、リストの最後が最終的に入力されるだけです。

#4では、金額と言う項目から推測して合計金額に変えましたが、何を意味しているのでしょうか?
この回答への補足あり
    • good
    • 0

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


補足の内容とコードの内容は一致していません。
示されているプログラムの流れですと、
n = Worksheets("リスト").Cells(Rows.Count, "A").End(xlUp).Row
シート名 リストのA列の最終行を変数nに代入
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)
の前にもコードがあるのでしょうか?

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

#4のコードはご質問のコードをまとめたものです。
シート名 原本とリストがある事が条件になります。
リストを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
この回答への補足あり
    • good
    • 0

>とまってしまいます。



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

#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 は不要なので違う使い方に割り当てました。

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

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

このQ&Aを見た人はこんなQ&Aも見ています


このQ&Aを見た人がよく見るQ&A

人気Q&Aランキング