昨日以下の質問をさせていただいた者です。
http://oshiete.goo.ne.jp/qa/8349562.html
こちらで教えていただいた以下のコードに、
J2のセルに連番を振るコードを付け足したいと思い、
同じくこちらのサイトの過去の履歴にあった以下コードを参考にとやってみているのですが、
Next で指定された変数の参照が無効です。と言われてしまいます…
印刷部数の指定はいらず、sheet印刷のJ2セルに1から始まる連番を振りたいのです。
どのように修正をしたらいいのかご教示願います。
Sub Sample4()
Dim i As Long, endRow1 As Long, endRow2 As Long, myArea1 As Range, myArea2 As Range
Dim wS1 As Worksheet, wS2 As Worksheet, wS3 As Worksheet
Set wS1 = Worksheets("DB")
Set wS2 = Worksheets("印刷")
Set wS3 = Worksheets("Sheet3")
endRow1 = wS1.Cells(Rows.Count, "A").End(xlUp).Row
Range(wS1.Cells(1, "A"), wS1.Cells(endRow1, "A")).AdvancedFilter Action:=xlFilterInPlace, unique:=True
wS1.Range("A:A").Copy wS3.Range("A1")
wS1.ShowAllData
For i = 2 To wS3.Cells(Rows.Count, "A").End(xlUp).Row
endRow2 = wS2.Cells(Rows.Count, "B").End(xlUp).Row
If endRow2 > 9 Then
Range(wS2.Cells(10, "B"), wS2.Cells(endRow2, "H")).ClearContents
Range(wS2.Cells(10, "J"), wS2.Cells(endRow2, "J")).ClearContents
End If
wS1.Range("A1").AutoFilter field:=1, Criteria1:=wS3.Cells(i, "A")
wS2.Range("B6") = wS3.Cells(i, "A")
Set myArea1 = Range(wS1.Cells(2, "B"), wS1.Cells(endRow1, "H")).SpecialCells(xlCellTypeVisible)
Set myArea2 = Range(wS1.Cells(2, "I"), wS1.Cells(endRow1, "I")).SpecialCells(xlCellTypeVisible)
myArea1.Copy
wS2.Activate
ActiveSheet.Range("B10").Select
Selection.PasteSpecial Paste:=xlPasteValues
myArea2.Copy
wS2.Activate
ActiveSheet.Range("J10").Select
Selection.PasteSpecial Paste:=xlPasteValues
endRow2 = wS2.Cells(Rows.Count, "B").End(xlUp).Row
'Range(wS2.Cells(1, "A"), wS2.Cells(endRow2, "J")).PrintOut
Next i
wS1.AutoFilterMode = False
wS3.Cells.Clear
End Sub
連番印刷のコード
Sub NumberPrint()
Dim idx As Integer
Dim res
res = Application.InputBox("印刷部数を入力してください", Type:=1)
If res > 0 Then
For idx = 1 To res
Range("AW3").Value = idx
ActiveSheet.PrintOut
Next idx
End If
End Sub
No.1
- 回答日時:
こんばんは!
前回回答した者です。
>sheet印刷のJ2セルに1から始まる連番を振りたいのです。
J2セルに連番というコトはいくら行数が多くて何ページになっても1度しか印刷されないので
前回の質問だと「200」の場合に「1」・「300」の場合に「2」・・・
という感じの連番になればよいのですよね?
(印刷枚数ではない!という解釈)
そうであれば単純に1行だけ追加すれば大丈夫だと思います。
前回のコードの○行と△行の間!といっても行数が多いので、もう一度コードを載せてみます。
(★マークのところを追加しただけです)
Sub Sample5()
Dim i As Long, endRow1 As Long, endRow2 As Long, myArea1 As Range, myArea2 As Range
Dim wS1 As Worksheet, wS2 As Worksheet, wS3 As Worksheet
Set wS1 = Worksheets("DB")
Set wS2 = Worksheets("印刷")
Set wS3 = Worksheets("Sheet3")
endRow1 = wS1.Cells(Rows.Count, "A").End(xlUp).Row
Range(wS1.Cells(1, "A"), wS1.Cells(endRow1, "A")).AdvancedFilter Action:=xlFilterInPlace, unique:=True
wS1.Range("A:A").Copy wS3.Range("A1")
wS1.ShowAllData
For i = 2 To wS3.Cells(Rows.Count, "A").End(xlUp).Row
endRow2 = wS2.Cells(Rows.Count, "B").End(xlUp).Row
If endRow2 > 9 Then
Range(wS2.Cells(10, "B"), wS2.Cells(endRow2, "H")).ClearContents
Range(wS2.Cells(10, "J"), wS2.Cells(endRow2, "J")).ClearContents
End If
wS1.Range("A1").AutoFilter field:=1, Criteria1:=wS3.Cells(i, "A")
wS2.Range("J2") = i - 1 '←★この行のみ追加★
wS2.Range("B6") = wS3.Cells(i, "A")
Set myArea1 = Range(wS1.Cells(2, "B"), wS1.Cells(endRow1, "H")).SpecialCells(xlCellTypeVisible)
Set myArea2 = Range(wS1.Cells(2, "I"), wS1.Cells(endRow1, "I")).SpecialCells(xlCellTypeVisible)
myArea1.Copy
wS2.Activate
ActiveSheet.Range("B10").Select
Selection.PasteSpecial Paste:=xlPasteValues
myArea2.Copy
wS2.Activate
ActiveSheet.Range("J10").Select
Selection.PasteSpecial Paste:=xlPasteValues
endRow2 = wS2.Cells(Rows.Count, "B").End(xlUp).Row
Range(wS2.Cells(1, "A"), wS2.Cells(endRow2, "J")).PrintOut
Next i
wS1.AutoFilterMode = False
wS3.Cells.Clear
End Sub
こんな感じではどうでしょうか?m(_ _)m
この回答への補足
tom04さま、こんばんは!
昨日に引き続きありがとうございます。
印刷したものを配布回収するので回収の際の漏れチェックに、
と思い連番を振りたかったので、=印刷枚数で教えていただきたいです。
自分でやってみたのですが全て「1」になってしまい、
途方に暮れています…
また本日セル番地と転記後の値をクリア(書式はそのまま)のコードを追加し以下のようになっております。
遅い時間に申し訳ありませんが、
明日提出しなければならなくて焦っております。
どうかよろしくお願いいたします。
Sub Sample4()
Dim i As Long, endRow1 As Long, endRow2 As Long, myArea1 As Range, myArea2 As Range
Dim wS1 As Worksheet, wS2 As Worksheet, wS3 As Worksheet
Set wS1 = Worksheets("DB")
Set wS2 = Worksheets("印刷")
Set wS3 = Worksheets("Sheet3")
endRow1 = wS1.Cells(Rows.Count, "A").End(xlUp).Row
Range(wS1.Cells(1, "A"), wS1.Cells(endRow1, "A")).AdvancedFilter Action:=xlFilterInPlace, unique:=True
wS1.Range("A:A").Copy wS3.Range("A1")
wS1.ShowAllData
For i = 2 To wS3.Cells(Rows.Count, "A").End(xlUp).Row
endRow2 = wS2.Cells(Rows.Count, "B").End(xlUp).Row
If endRow2 > 9 Then
Range(wS2.Cells(10, "B"), wS2.Cells(endRow2, "H")).ClearContents
Range(wS2.Cells(10, "J"), wS2.Cells(endRow2, "J")).ClearContents
End If
wS1.Range("A1").AutoFilter field:=1, Criteria1:=wS3.Cells(i, "A")
wS2.Range("J2") = i - 1 '←★この行のみ追加★
wS2.Range("B2") = wS3.Cells(i, "A")
Set myArea1 = Range(wS1.Cells(2, "B"), wS1.Cells(endRow1, "H")).SpecialCells(xlCellTypeVisible)
Set myArea2 = Range(wS1.Cells(2, "I"), wS1.Cells(endRow1, "I")).SpecialCells(xlCellTypeVisible)
myArea1.Copy
wS2.Activate
ActiveSheet.Range("B4").Select
Selection.PasteSpecial Paste:=xlPasteValues
myArea2.Copy
wS2.Activate
ActiveSheet.Range("J4").Select
Selection.PasteSpecial Paste:=xlPasteValues
endRow2 = wS2.Cells(Rows.Count, "B").End(xlUp).Row
Range(wS2.Cells(1, "A"), wS2.Cells(endRow2, "J")).PrintOut
Range("B4:J503").ClearContents
Next i
wS1.AutoFilterMode = False
wS3.Cells.Clear
End Sub
No.2ベストアンサー
- 回答日時:
No.1です。
印刷枚数の連番をご希望だった!というコトですね。
VPageBreakオブジェクトなどを利用して、改ページの回数を参考にしてみたのですが、
結局1からの連番ではなく、そのSheetの総ページ数しか表示できないようです。
ただ、これでは何もお役に立てないので、苦肉の策として、ヘッダーで対応してはダメですか?
ヘッダーの編集で &[ページ番号]/&[総ページ数]
とすれば、とりあえずは 各項目ごとの総ページ数に対する何ページ目か?は表示できると思います。
全部のページ枚数は表示できませんが、この程度しか思いつきません。
ごめんなさいね。m(_ _)m
いえいえ、度々助けていただいて感謝です。
ありがとうございます。
はじめヘッダーでやったんですが、
やはり印刷枚数で出したくて…
でもこれで本当に十分満足です!
ありがとうございました!
お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!
似たような質問が見つかりました
- Visual Basic(VBA) エクセルVBAで教えて頂きたいのですが? 2 2022/12/31 20:28
- Excel(エクセル) VBAの指示の内容 昨日こちらでご教示頂いたのですが初心者な為、一つ一つの指示が何をやっているのかわ 2 2022/10/25 18:08
- Visual Basic(VBA) 【至急】Excel 同一人物の情報を一行にまとめる(複数行) 6 2022/05/24 17:58
- Visual Basic(VBA) VBA処理追加 こちらでご教示頂いたのですが回答完了させてしまいましたのでこちらからまた質問させてく 2 2022/10/27 09:57
- Visual Basic(VBA) ExcelVBAの転記について 1 2022/03/23 20:13
- Visual Basic(VBA) Excel VBA キーワードから列を取得して、さらに空欄行を非表示にする 3 2022/10/21 22:49
- Visual Basic(VBA) vbaを早くしたい 5 2022/09/09 10:58
- Visual Basic(VBA) Excelで下記のようにマクロを作ったところ、一回目は実行できたのですが、二回目以降「実行時エラー1 1 2022/03/25 08:08
- Visual Basic(VBA) 前回ご教授いただいたコードに覚えたてのループ処理で品名りんごAから順に20回for nextでループ 7 2023/01/13 22:01
- Excel(エクセル) マクロで最終行から上に検索を逆にしたい 1 2022/05/17 18:27
関連するカテゴリからQ&Aを探す
おすすめ情報
デイリーランキングこのカテゴリの人気デイリーQ&Aランキング
-
セルの文字を「印刷時だけ非表...
-
Excel フィルタをかけた後の各...
-
エクセルで「白字」を印刷した...
-
コンビニでpdfを四つで一つにし...
-
wordで印刷の頁順を変えたい
-
ファミマでPDFを両面印刷したの...
-
何もしていないのに印刷したら...
-
Wordによる宛名印刷
-
表題、目次ページがある文書の...
-
Excel セル内に見たことのない...
-
エクセルのピボットテーブル集...
-
エクセルのみで長3封筒に宛名...
-
PDFファイルの選択した部分...
-
ワードで1ページだけ印刷出来ない
-
PDFファイルをワードやエクセル...
-
編集記号を印刷したい
-
ワードの差込印刷部分の背景部...
-
Firefoxの右クリックメニューに...
-
Edge、[画面で選択されたとおり...
-
PDF-XChange Editorのテキスト...
マンスリーランキングこのカテゴリの人気マンスリーQ&Aランキング
-
セルの文字を「印刷時だけ非表...
-
エクセルで「白字」を印刷した...
-
Excel フィルタをかけた後の各...
-
コンビニでpdfを四つで一つにし...
-
何もしていないのに印刷したら...
-
PDF-XChange Editorのテキスト...
-
ワードの差込印刷部分の背景部...
-
wordで印刷の頁順を変えたい
-
作成中のメールを印刷する方法...
-
Edge、[画面で選択されたとおり...
-
ワードで背景の画像を印刷しな...
-
エクセルのみで長3封筒に宛名...
-
ネットのページをPDFで保存して...
-
ファミマでPDFを両面印刷したの...
-
WORD 印刷すると文字が重なる
-
PDFファイルの選択した部分...
-
画面通りに印刷されず(Word2013)
-
indeedのweb求人内容を印刷した...
-
背景色を消して白地に黒でモノ...
-
違うページが印刷される
おすすめ情報