• ベストアンサー

【エクセル】 連続印刷する際のマクロの記述について。

いつも大変お世話になっております。 エクセル2003のマクロの記述についてご教示のほど お願いいたします。 シート2にシート1の名簿から住所氏名等を落とし込み出来るように様式を作っています。 このシート3には、以下のVBAが設定してあります。 ********************************** Sub osieteinsatsu02() ' Dim start As Long Dim stp As Long Dim i As Long start = Range("a1") stp = Range("c1") For i = start To stp Range("a1") = i Sheets("Sheet2").Select ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True Sheets("sheet3").Select Next End Sub ********************************** ↑ このシートのA1の値(名簿番号)~C1の値の人のデータをシート2に落とし込み、 シート2に行き様式を一枚印刷する。 このように記述してあると思います。 ところで、様式の中に複数名をまとめたいと思いますので、例えば、A1の値を変えるときに4つ置きに変化させるにはどのように記述すれば良いのでしょうか? 1、6、11、16、、、C1の値までで止まる。 どうぞよろしくお願いします。

  • fsy
  • お礼率91% (225/246)

質問者が選んだベストアンサー

  • ベストアンサー
回答No.1

以下でOKなはずです。 For i = start To stp Step 5 以下のヘルプに記述されています。mk:@MSITStore:C:\Program%20Files\Common%20Files\Microsoft%20Shared\VBA\VBA6\1041\VBLR6.CHM::/html/vastmfor.htm

fsy
質問者

お礼

誠にありがとうございました。 効率が良くなり別の事にも活かせそうです。

その他の回答 (1)

  • imogasi
  • ベストアンサー率27% (4737/17068)
回答No.2

Sheet1のA2:A13に 氏名1 住所1 年齢1 出身地1 氏名2 住所2 年齢2 出身地2 氏名3 住所3 年齢3 出身地3 Sheet2が印刷シートとして B2 氏名 B4 住所 B6 年齢 B8 出身地 を印刷するとします 標準モジュールに Sub test01() Dim sh1 As Worksheet Dim sh2 As Worksheet Set sh1 = Worksheets("Sheet1") Set sh2 = Worksheets("Sheet2") d = sh1.Range("A65536").End(xlUp).Row For i = 2 To d Step 4 sh2.Cells(2, "B") = sh1.Cells(i, "A") sh2.Cells(4, "B") = sh1.Cells(i + 1, "A") sh2.Cells(6, "B") = sh1.Cells(i + 2, "A") sh2.Cells(8, "B") = sh1.Cells(i + 3, "A") sh2.Range("A1:H10").PrintOut Next i End Sub を入れ実行(テスト済み) For i = 2 To d Step 4 With sh2 .Cells(2, "B") = sh1.Cells(i, "A") .Cells(4, "B") = sh1.Cells(i + 1, "A") .Cells(6, "B") = sh1.Cells(i + 2, "A") .Cells(8, "B") = sh1.Cells(i + 3, "A") .Range("A1:H10").PrintOut End With Next i も可能。 sh1.Cells(i + 1, "A")のところで sh1.Cells(i , "A").Offset(1,0)なども使える

fsy
質問者

お礼

ありがとうございます。大変参考になりました。

関連するQ&A

  • エクセルVBAマクロの質問です。

    マクロ初心者です。行き詰まってます。 sheet1には300件程度のデータがあります。 このデータの3列目の値を、VLOOKUPでsheet3のA1:B30範囲から参照します。そこで取得した回数分、sheet1の各行のデータをsheet2にコピーしたいんです。 そこで、コード文を作ってみましたが、マクロがうまく動きません。 すみませんが、お知恵を貸していただけないでしょうか? Dim Z as Long Dim L As Long Dim P As Long Dim Kensaku As String Dim M4 As Range Dim PRow As Long Dim i As Long Set M4 =Sheets(“sheet3”).Range(“A1:B30“) L = Sheets(“sheet1”).Range(“A1”).End(xlup).Row For Z = 1 to L-1 Kensaku = Sheets(“sheet1”).Cells(Z+1,3).Value P=Worksheetfunction.Vlookup(Kensaku,M4,2,False)    For i = 1 to P      Prow=Sheets(“sheet2”).Range("A1").End(xlDown).Row      Sheets(“sheet1”).Rows(Z+1).Copy Sheets(“sheet2”).Rows(Prow)    Nexti Next Z

  • エクセル マクロ 抽出

    教えてください。 ○と記入されたセルを参照して、一つ上のセル・A列にある同じ行のセル・ 9行目にある同じ列のセルを抽出しようとしています。 下記の通り入力すると 行数=値.Rowでエラーが出たしまいました。 試行錯誤頑張りましたが解決できそうにありませんのでお力を貸して頂けないでしょうか。 Sub 抽出() Dim i, 行数, 列数 As Long Dim 値 As Range i = 0 行数 = 値.Row 列数 = 値.Column For Each 値 In Sheets("sheet1").Range("C12:R171") If 値.Value = "○" Then i = i + 1 With Sheets("sheet2") .Cells(i, 3).Value = Sheets("sheet1").Cells(行数, 1).Value .Cells(i, 4).Value = Sheets("sheet1").Cells(9, 列数).Value .Cells(i, 5).Value = 値.Offset(-1, 0).Value End With End If Next End Sub

  • エクセルマクロ:範囲の選択

    マクロで範囲を指定したいのですが、 dataと名づけたシートA1に例えば8という値、A2に20という値があります。 この数字は他のセルから参照する計算式になっていて再計算をするたびに変わります。 この時、C8:E20の範囲を指定したいのですが、やみくもに Dim c As Integer c = 3 'C列 Range(Cells(Sheets("data").Range("A1").Value, c), Cells(Sheets("data").Range("A2").Value, c + 2)).Select Selection.Copy などと書いてみたのですが、うまくいきません。 どのように記述すればよいか、教えてください、宜しくお願いいたします。

  • エクセルVBAマクロの質問です。

    マクロ初心者です。 データ処理のマクロを作ろうとしていて、ちょっと困ってます。 (sheet1) 11 国総 1A (空きセル ) 12 化基 2I (空きセル) ・ 以下、200程度のデータ C列のデータの種類は10種類 (sheet2) 1A 2 101 102 2I 3 103 104 105 ・ ・ sheet1のC列と同じデータ C列より右側のデータ数は1から4個程度 (sheet3) データなし sheet1のデータを、sheet3にコピーする際に、各データのD列に、sheet2のC列の右側のデータを入れていきたいんです。具体的には (sheet3) 11 国総 1A 101 11 国総 1A 102 12 化基 2I 103 12 化基 2I 104 12 化基 2I 105 っていう感じです。先日、こちらのカテゴリでなく、間違えてVBAプログラムの方に質問して、「板違いですよ」と諭されながらも、ご協力いただきsheet2の件数分増やしてコピーするコードまではたどり着いたのですが、その後、どうすればD列に移せるのかで悩んでます。ちなみに、いまたどりついたコード文は以下の通りです。 一度、このコード文の続きで、sheet3のC列を条件カウントするコードを作ってみたんですが、動いてくれませんでした。 Sub Re8928577a() Dim M4 As Range Dim P As Variant ' WorksheetFunction.VLookup Dim Kensaku As String Dim L As Long Dim PRow As Long Dim i As Long Dim Z As Long   Set M4 = Sheets("Sheet2").Range("A1:B30")   L = Sheets("Sheet1").Cells(Rows.Count, "A").End(xlUp).Row '   For Z = 1 To L - 1     Kensaku = Sheets("Sheet1").Cells(Z + 1, 3).Value     P = WorksheetFunction.VLookup(Kensaku, M4, 2, False)     PRow = Sheets("Sheet3").Cells(Rows.Count, "A").End(xlUp).Row       For i = PRow + 1 To PRow + P         Sheets("Sheet1").Rows(Z + 1).Copy Sheets("Sheet3").Rows(PRow + 1).Resize(P) Next i   Next Z End Sub

  • エクセルのマクロについての質問です。

    エクセルのマクロについての質問です。 複数のシートのデータを一つのシートにまとめるマクロを使用しています。 以下のものになります。 Sub まとめ() Dim i As Long, ii As Long ii = 1 With Worksheets .Add before:=.Item(1) For i = 2 To .Count .Item(i).Range("BX6:CQ15").Copy .Item(1).Cells(ii, "A") .Item(i).Range("C59:U68").Copy .Item(1).Cells(ii, "U").PasteSpecial Paste:=xlPasteValues ii = ii + 10 Next i End With Application.CutCopyMode = False Range("1:1").Insert Sheets(2).Range("BX5:CQ5").Copy Sheets(1).Range("A1") Sheets(2).Range("C58:U58").Copy Sheets(1).Range("U1") Columns("B").SpecialCells(xlCellTypeBlanks).EntireRow.Delete Sheets(1).Columns("C:D").Delete Sheets(1).Columns("F:G").Delete Sheets(1).Columns("G:O").Delete End Sub このマクロを使用してまとめたシートの数値の部分(各シートのC59:U68のデータを貼り付けた部分、まとめたシートのH2のセルが起点です)を変更するとコピー元(各シートのC59:U68)の数値も同じように変わるというものを作りたいです。 いろいろと調べましたが手も足も出ませんでした。 ご教示いただけないでしょうか? 宜しくお願いいたします。

  • エクセル2003マクロの機能追加

    Sub test() Dim 行1 As Long, 最終行 As Long, 行2 As Long Sheets("Sheet2").Cells.ClearContents Sheets("Sheet1").Activate 最終行 = Range("C65536").End(xlUp).Row 行2 = 1 For 行1 = 1 To 最終行 Sheets("Sheet2").Cells(行2, 1).Resize(1, 3) = Range(Cells(行1, 1), Cells(行1, 3)).Value If Range("A" & 行1).Font.Bold Then Sheets("Sheet2").Range("A" & 行2) = Range("A" & 行1) & "-1" Sheets("Sheet2").Cells(行2 + 1, 1).Resize(1, 3) = Range(Cells(行1, 1), Cells(行1, 3)).Value Sheets("Sheet2").Range("A" & 行2 + 1) = Range("A" & 行1) & "-2" 行2 = 行2 + 1 End If If Range("A" & 行1) = "" Then 行2 = 行2 - 1 Sheets("Sheet2").Range("C" & 行2) = Sheets("Sheet2").Range("C" & 行2) + Range("C" & 行1) End If 行2 = 行2 + 1 Next 行1 End Sub 元データ AAAA5 9601  950 BBBB1 9660  150 ASAS9 9654  -50 AXCW5 9603  1375 以下の用にマクロで変換する機能を追加したいのです AAAA5 9601  950 BBBB1-1 9660  150 BBBB1-2 9660  150 ASAS9 9654  50 AXCW5 9603  1375 宜しくおねがいします。

  • エクセル2003マクロの再編集

    Sub test() Dim 行1 As Long, 最終行 As Long, 行2 As Long Sheets("Sheet2").Cells.ClearContents Sheets("Sheet1").Activate 最終行 = Range("C65536").End(xlUp).Row 行2 = 1 For 行1 = 1 To 最終行 Sheets("Sheet2").Cells(行2, 1).Resize(1, 3) = Range(Cells(行1, 1), Cells(行1, 3)).Value Sheets("Sheet2").Cells(行2, 3).Value = Abs(Sheets("Sheet2").Cells(行2, 3).Value) If Range("A" & 行1).Value = "BBBB1" Then Sheets("Sheet2").Range("A" & 行2) = Range("A" & 行1) & "-1" Sheets("Sheet2").Cells(行2 + 1, 1).Resize(1, 3) = Range(Cells(行1, 1), Cells(行1, 3)).Value Sheets("Sheet2").Range("A" & 行2 + 1) = Range("A" & 行1) & "-2" 行2 = 行2 + 1 End If If Range("A" & 行1) = "" Then 行2 = 行2 - 1 Sheets("Sheet2").Range("C" & 行2) = Sheets("Sheet2").Range("C" & 行2) + Range("C" & 行1) End If 行2 = 行2 + 1 Next 行1 End Sub を編集したいのですが全然図りません ご指導お願いします 元データ AAAA5 9601  950 BBBB1 9660  150 ASAS9 9654  -50 AXCW5 9603  1375 以下の用にマクロで変換する用に出来たのですが 【1】 BBBB1だけではなくAAAA5も対処になったときの 追加方法です 元データは一切変更が出来ません ※フォントの変更も不可です 【2】 元データと変換後データがSheet1からSheet2になっていますが Sheet1の元は範囲はA1~C400で変換後をSheet1E1~G400にしたいのです AAAA5 9601  950  BBBB1-1 9660  150  BBBB1-2 9660  150 ASAS9 9654  50 AXCW5 9603  1375

  • エクセルの連続印刷マクロについて

    VBAの知識がなく困っています。 エクセルのC1を+1、B5を+10連番で増やして印刷したいのですが、Webで調べた下記の記述に、色々プラスしてみましたが、片方の数しか増えません。 ご教示お願いいたします。 Const conStart As Long = 51 '開始番号 Const conEnd As Long = 60 '終了番号 Const conStep As Long = 1 '間隔 Const conCell As String = "C1" 'セル番地 '変数 Dim i As Long With Application .ScreenUpdating = False With .ActiveSheet.Range(conCell) For i = conStart To conEnd Step conStep .Value = i ActiveSheet.PrintOut Next End With .ScreenUpdating = True End With End Sub

  • エクセルVBAについての質問です。

    エクセルVBAについての質問です。  動作環境は  OS:WINDOWS XP  エクセル2003  です。 今、Book1.xlsというエクセルファイルがあります。 このファイルの中に、【sheet1】,【sheet2】,【sheet3】の3つのシートが存在しています。 【sheet1】および【sheet2】には、A列=ユニーク番号、B列=データ1、C列=データ2・・・・n列=データnの値が約1500行(各行で、データの値は異なります。)入っています。 この【sheet1】と【sheet2】のデータの内容を照合して【sheet3】にその結果を反映(TRUEまたはFALSE)します。 仮に【sheet3】のあるセル(仮にD3)の値がTRUEとなったら、【sheet1】のセル(D3)の値を【sheet3】のセル(D3)に代入する。 逆に【sheet3】のあるセルの値がFALSEとなったら、そのセルはFLASEのままにする。プログラムは以下の様にしたのですが、全てを処理するまでに相当時間がかかっています。 VBAのプログラムは今回初めて書いたので、プログラムが悪いのか、プログラムの思想が悪いのかがわかりません。 どなたかご教授していただけませんか?多分、コードの書き方もキレイではないと思います(悲) Private Sub データ照合ボタン_DblClick(ByVal Cancel As MSForms.ReturnBoolean) Dim i As Long Dim area As Range Dim A As Variant Dim WrkRange As String '----シート(1)とシート(2)の各セルの値を比較---- With Sheets("sheet1") WrkRow = .Cells(Rows.Count, 3).End(xlUp).Row End With Sheets("sheet3").Select For i = 12 To WrkRow WrkRange = Range("C" & i).Select ActiveCell.FormulaR1C1 = "=EXACT('sheet1'!RC,'sheet2'!RC)" WrkRange = Range("D" & i).Select ActiveCell.FormulaR1C1 = "=EXACT('sheet1'!RC,'sheet2'!RC)" '・           '・           '・ Next i A = i - 1 Sheets("sheet1").Select For i = 12 To A WrkRange = Range("C" & i).Select Selection.Copy Range("C" & i).PasteSpecial xlPasteValues Sheets("sheet3").Select If Range("C" & i) = True Then Sheets("sheet1").Select Range("C" & i).Copy Sheets("sheet3").Select Range("C" & i).Select ActiveSheet.Paste Else: End If Next i A = i - 1 Sheets("sheet1").Select For i = 12 To A WrkRange = Range("D" & i).Select Selection.Copy Range("D" & i).PasteSpecial xlPasteValues Sheets("sheet3").Select If Range("D" & i) = True Then Sheets("sheet1").Select Range("D" & i).Copy Sheets("sheet3").Select Range("D" & i).Select ActiveSheet.Paste Else: End If Next i          '・          '・          '・    End Sub

  • Excel のアドイン

    Excel2003です。 xlaファイル内に次のような関数があった場合、  Function addinfunc(a As long, b As long) As long  Dim c As long  c = a + b  addinfunc = c  End Function シート上からは =addinfunc(B1,C1) という風に利用できますが、 xlsファイル内のプロシージャーから Debug.Print addinfunc(Sheets("Sheet1").Range("C1")), Sheets("Sheet1").Range("B1")) という風には使えません。 プロシージャー内で使うということはもともとできないのか、 何か設定があるのかどういうものでしょうか?

専門家に質問してみよう