Excel (VBA)

Excel VBAに関するフォーラムです。
  • 解決済みのトピックにはコメントできません。
このトピックは解決済みです。
質問

 
(Windows 10 Pro : Excel 2013)
印刷指定を増やす方法
投稿日時: 20/01/18 18:40:01
投稿者: ひっちん1

いつもお世話になっております
 
指定シートに印刷を行う場合についてご教授お願いします。
 
下記式で
    Worksheets("3回確認").Select
    LastRow = Cells(Rows.Count, 5).End(xlUp).Row
 
    For i = 6 To LastRow
        If Cells(i, 5).Value = "印刷" Then
            k = k + 1
            If k = 1 Then
                With Worksheets("3回実施")
                    .Range("A3").Value = Cells(i, 4).Value
                End With
            Else
                With Worksheets("3回実施")
                    .Range("A17").Value = Cells(i, 4).Value
                End With
              k = 0
              
            End If
        End If
    Next i
    '奇数個の場合の対応
    If k = 1 Then
        Worksheets("3回実施").PrintOut
        'Worksheets("印刷シート").PrintPreview
    End If
     
         
End Sub
 
もう一か所追加して印刷を行う方法を教えていただきたいのですが
 
  現在は2か所A3とA17に指定して問題なく数枚印刷を行うのですが
 
    上記式にA31にも追加して 3か所になる場合をご教授お願いします
           
                 With Worksheets("3回実施")
                    .Range("A31").Value = Cells(i, 4).Value
 
 
   質問の説明がずれているかもしれませんがよろしくお願いします。
 

回答
投稿日時: 20/01/18 19:58:04
投稿者: mattuwan44

>For i = 6 To LastRow
 
データ数分繰り返していると思うのですが、
 
ひたすら、A3とA17の値を書きなおすことになると思うのですが、それでいいんですか?
 
最後の2個または3個分のデータをきりがよくなったら印刷するという考えなんですかね?
 
何をしたいかを日本語で説明していただけませんか?
 
コードだけだと、質問者さんの意図がちゃんと反映されているかわかりません。

回答
投稿日時: 20/01/18 20:48:18
投稿者: WinArrow
投稿者のウェブサイトに移動

>現在は2か所A3とA17に指定して問題なく数枚印刷を行うのですが
 
本当に問題はないのでしょうか?
 
例えば
E列セルには、「印刷」がいくつ存在するのでしょうか?
2個だったら、問題ないと思います。
つまり、
1個目は、セルA3に
2個目は、セルA17に
代入されて印刷されるでしょう。
 
しかし、3個存在したとすると
セルA3は、最後の3個目が代入されて印刷されます。
結果的に、1個目の代入したデータは印刷されません。
 
追加したい・・・・という条件を付け加える場合、
変数「K」Kを「0」と「1」で制御するのではなく
 
変数:Kを1〜カウントアップして、Kを3で割って、余りを求めます。
余りが1は、1個目
余りが2は、2個目
余りが0は、3個目
となります、
勿論、Kを0に戻す必要はありません。
 
 
 

回答
投稿日時: 20/01/18 21:04:48
投稿者: WinArrow
投稿者のウェブサイトに移動

追加レス
 
最後に
K=1の時だけ、印刷する仕様になっていますが、
要は、「印刷」というセルが、偶数個の時という条件だと思うので
3個になった場合は、
余りが0の時と変更しなくていけませんね・・・
 
以下、4個以上になったとき応用が効くようにしたコードです。
参考までに
 
Dim Sht1 As Worksheet, Sht2 As Worksheet
Dim LastRow As Long, k As Long
 
 
    Set Sht1 = Worksheets("3回確認").Select
    Set Sht2 = Worksheets("3回実施")
      
    LastRow = Sht1.Cells(Sht1.Rows.Count, "E").End(xlUp).Row
    k = 0
    For i = 6 To LastRow
        If Sht1.Cells(i, "E").Value = "印刷" Then
            k = k + 1
            Select Case k Mod 3
                Case 1
                    Sht2.Range("A3").Value = Sht1.Cells(i, "D").Value
                Case 2
                    Sht2.Range("A17").Value = Sht1.Cells(i, "D").Value
                Case 0
                    Sht2.Range("A31").Value = Sht1.Cells(i, "D").Value
             End Select
        End If
     Next i
    If k Mod 3 = 0 Then
        Sht2.PrintOut
    End If
    Set Sht2 = Nothing
    Set Sht1 = Nothing
           
 
 
 

回答
投稿日時: 20/01/18 22:03:05
投稿者: WinArrow
投稿者のウェブサイトに移動

一部コードが枚がっていました。
 
> Set Sht1 = Worksheets("3回確認").Select

    Set Sht1 = Worksheets("3回確認")
に修正してください。

回答
投稿日時: 20/01/19 12:31:00
投稿者: mattuwan44

WinArrowさんの回答を読んでやりたいことが分かったかも?^^;
 
1から3個の値限定で転記して印刷ってことですかね?
4とか10個とかでも印刷可能ですが、
それはとりあえずおいておいてってことですかね?
 
いろんな書き方(どこに主眼をおいて表現するか)があるとは思いますが、
とりあえず一例。
 

Sub test()
    Dim rngTo As Range
    Dim rngFrom As Range
    Dim n As Long
    Dim i As Long
    Dim j As Long

    Set rngTo = Worksheets("3回実施").Range("A3,A17,A31")
    Set rngFrom = Worksheets("3回確認").UsedRange.Columns("E")

    'セルを初期化
    rngTo.ClearContents
    '「印刷」という値が3個以下か確認
    i = WorksheetFunction.CountIf(rngFrom.Offset(, 1).Cells, "印刷")
        If i < 4 And i > 0 Then
        '使用されている6行目から最後までをループ
        For i = 6 To rngFrom.Cells.Count
            '右隣りに「印刷」と入っていたら
            If rngFrom.Cells(i, 2).Value = "印刷" Then
                '個数をカウント
                j = j + 1
                '値を転記
                rngTo.Areas(j).Value = rngFrom.Cells(i, 1).Value
            End If
            '数えた個数になったら、その下は見なくていいのでループを抜ける
            If j = i Then Exit For
        Next
        '印刷
        Worksheets("3回実施").PrintPreview
    Else
        '条件に反するのでメッセージをだす。
        MsgBox "1〜3個の範囲で印刷指定してください。"
    End If
End Sub

 
個人的に最初にセル範囲を取得してやるのが好きなのでこういう書き方になります。

投稿日時: 20/01/19 14:53:04
投稿者: ひっちん1

mattuwan44さん
WinArrowさん
 
ご注意・ご指導・ご教授ありがとうございます
 
ご指摘いただきました通り、
質問の意図が伝わるように詳しく書くべきでした
申し訳ございません。
 
Worksheets("3回確認")のE列には、印刷というセルが複数あります
 (場合によっては、10個または13個または14個・・・・いろいろ違う場合があります)
 
3回確認シートの印刷セルを判断して3回実行セルに転記させて印刷を行う方法を、お聞きしたいことです
 
前回記載した式とは若干違いますが
Sub 印刷1()
    Dim i As Long
    Dim k As Long
    Dim LastRow As Long
    Worksheets("3回確認").Select
    LastRow = Cells(Rows.Count, 5).End(xlUp).Row
 
    For i = 6 To LastRow
        If Cells(i, 5).Value = "印刷" Then
            k = k + 1
            If k = 1 Then
                With Worksheets("3回実施")
                    .Range("A3").Value = Cells(i, 4).Value
                End With
            Else
                With Worksheets("3回実施")
                    .Range("A17").Value = Cells(i, 4).Value
                End With
               .Range("A3,A17").ClearContents
                End With
                k = 0
            End If
        End If
    Next i
    '奇数個の場合の対応
    If k = 1 Then
        Worksheets("3回実施").PrintOut
        'Worksheets("3回実施").PrintPreview
    End If
End Sub
 
上記式では3回実施シートの2か所(A3,A17)に代入させて印刷は問題なくできのですが
(印刷セルが3個の場合は2枚の用紙・印刷セルが4個の場合は2枚の用紙・印刷セルが5個の場合は3枚の用紙・・・)
 
3回実施シートの2か所(A3,A17)から、3か所に追加転記する場合(A3,A17,A31)の方法と、
印刷セル数がいろいろ変わる(印刷セルが3個の場合は1枚の用紙・印刷セルが4個の場合は2枚の用紙・印刷セルが7個の場合は3枚の用紙・・・)ときに対応した式をご教授お願いしたいと思っております。
 
WinArrowさんにご教授いただいた式では
私の説明が悪いため、意図する結果の印刷ができませんでした
説明が下手で申し訳ございません。
 
 
 
 
 
 
 
 

回答
投稿日時: 20/01/19 16:18:37
投稿者: WinArrow
投稿者のウェブサイトに移動

3つ揃ったら、印刷
ってことなの?

投稿日時: 20/01/19 16:35:50
投稿者: ひっちん1

ご返答ありがとうございます
 
3つ揃ったら印刷ではありません
 
1つでも印刷、2つでも印刷、3つでも印刷
4つでは2枚目に印刷(1枚目に1〜3までを印刷して2枚目に4つ目を印刷)
5つでは2枚目に印刷(1枚目に1〜3までを印刷して2枚目に4つ目と5つ目を印刷)
6つでは2枚目に印刷(1枚目に1〜3までを印刷して2枚目に4〜6つ目を印刷)
7つでは3枚目に印刷(1枚目に1〜3までを印刷して2枚目に4〜6つ目を印刷して3枚目に7つ目を印刷)
 ・
 ・
と続きます
 
説明が下手で申し訳ございません

回答
投稿日時: 20/01/19 16:48:41
投稿者: mattuwan44

3回確認
3回実施
 
という名前がどうしても紛らわしいです。
 
ある条件のときは、3回になるから、
とりあえず3回になる条件で動作確認しているから、その名前なんですかね?
 
やりたいことは、
 
印刷したいデータが何件かある。
それらを、
2件配置出来るシートと3件配置できるシートが用意されいるうち、
たとえば、
8件の印刷したいデータがあるとき(何件かあるデータのうち印刷したいデータに目印を付けている)、
3件配置できるシートに転記しながら(3件分転記したら印刷を繰り返す)、
印刷したいということですか?(結果的に3回印刷することになる)
 

回答
投稿日時: 20/01/19 18:37:55
投稿者: simple

# 横入り失礼します。
 
こういうことですか?
なお、最後の3カ所未満しかデータがないものも、他と同じ印刷範囲であるという前提です。
 

Sub 印刷1()
    Dim ws As Worksheet
    Dim lastRow As Long
    Dim i As Long
    Dim k As Long

    Set ws = Worksheets("3回確認")

    lastRow = Cells(Rows.count, 5).End(xlUp).Row

    For i = 6 To lastRow
        If Cells(i, 5).Value = "印刷" Then
            k = k + 1
            Select Case k Mod 3
                Case 1: ws.Range("A3").Value = Cells(i, 4).Value
                Case 2: ws.Range("A17").Value = Cells(i, 4).Value
                Case 0
                    ws.Range("A31").Value = Cells(i, 4).Value
                    ws.PrintPreview     '確認用
                    'ws.Printout        '本番用
                    ws.Range("A3,A17,A31").ClearContents
            End Select
        End If
    Next i
    If k Mod 3 <> 0 Then  'まだ印刷していない箇所を印刷。(落ち穂拾い)
        ws.PrintPreview     '確認用
        'ws.Printout        '本番用
    End If
End Sub

投稿日時: 20/01/19 18:42:12
投稿者: ひっちん1

3回確認・3回実施・・・名前紛らわしくてすみません
 
別にシート名ですので確認シート・実施シートでも何でもよいです・・・
 一枚の印刷で3件分印刷できるだけ意味です
 
確認シートのEセルに印刷と出ている、セルの横の(Dセルの)数値を
実施シートの(A3,A17,A31)に順番に表示させて印刷を行うという意味です
 
確認シートのEセルに印刷と表示してあるセルが1件しかない場合は、
実施シートのA3に1個目の横のDセルの値を表示させ 
  1件で印刷・・・印刷用紙は1枚必要
 
確認シートのEセルに印刷と表示してあるセルが2件の場合は、
実施シートのA3に1件目の印刷セル表示の横のDセルの値を表示させ
      A17に2件目の印刷セル表示の横のDセルの値を表示させ
  2件で印刷・・・印刷用紙は1枚必要
 
確認シートのEセルに印刷と表示してあるセルが3件の場合は、
実施シートのA3に1件目の印刷セル表示の横のDセルの値を表示させ
      A17に2件目の印刷セル表示の横のDセルの値を表示させ
      A31に3件目の印刷セル表示の横のDセルの値を表示させ
  3件で印刷・・・印刷用紙は1枚必要
 
確認シートのEセルに印刷と表示してあるセルが4件の場合は、
実施シートのA3に1件目の印刷セル表示の横のDセルの値を表示させ
      A17に2件目の印刷セル表示の横のDセルの値を表示させ
      A31に3件目の印刷セル表示の横のDセルの値を表示させ
  3件で印刷(ここで印刷用紙は1枚必要)した後
  4件目をもう一度
実施シートのA3に1件目の印刷セル表示の横のDセルの値を表示させ
  1件で印刷・・・4件の場合は印刷用紙は2枚必要
 
 というような繰り返しとなり
 
WinArrowさんがおっしゃる通り
印刷したいデータが何件かあります
 
印刷したいデータをすべて印刷したいということになります
 
20件中の8件の印刷したいデータがあるとき
(何件かあるデータのうち印刷したいデータに・・・印刷という目印を付けている)←印刷という目印が、ややこしくてすみません
3件配置できる実施シートに転記しながら(3件分転記したら次の目印の印刷を繰り返す)
印刷したいということです
 
すみません説明が下手で・・・まだ説明が不足だと思いますが
 
よろしくお願いします。
 
 
 
 
 

回答
投稿日時: 20/01/19 18:46:57
投稿者: simple

最後の

    If k Mod 3 <> 0 Then  'まだ印刷していない箇所を印刷。(落ち穂拾い)
        ws.PrintPreview     '確認用
        'ws.Printout        '本番用
    End If
のところに、一行追加してください。
    If k Mod 3 <> 0 Then  'まだ印刷していない箇所を印刷。(落ち穂拾い)
        ws.PrintPreview     '確認用
        'ws.Printout        '本番用
        ws.Range("A3,A17,A31").ClearContents
    End If

なお、PrintPreviewとPrintoutを併記している理由はわかりますね。
テスト実行は、PrintPreviewでやって紙を節約してください、ということ。

回答
投稿日時: 20/01/19 22:24:51
投稿者: WinArrow
投稿者のウェブサイトに移動

基本的に、simpleさんのご意見に賛同します。
ただ、シートが転記元と転記先が逆になっているような気がします。
それから、転記元シートがアクティブになっていることが前提になっていますので、
転記元シートで修飾したほうが確実でしょう。
少し、変更したコードを掲示します。

Option Explicit

Sub 印刷1()
    Dim ws1 As Worksheet, ws2 As Worksheet
    Dim LastRow As Long
    Dim i As Long
    Dim k As Long

    Set ws1 = Worksheets("3回確認")
    Set ws2 = Worksheets("3回実施")

    With ws1
        LastRow = .Cells(.Rows.Count, 5).End(xlUp).Row
        For i = 6 To LastRow
            If .Cells(i, 5).Value = "印刷" Then
                k = k + 1
                Select Case k Mod 3
                    Case 1: ws2.Range("A3").Value = .Cells(i, 4).Value
                    Case 2: ws2.Range("A17").Value = .Cells(i, 4).Value
                    Case 0
                        ws2.Range("A31").Value = .Cells(i, 4).Value
                        GoSub ws2Print
                End Select
            End If
        Next i
    End With
    If k Mod 3 <> 0 Then  'まだ印刷していない箇所を印刷。(落ち穂拾い)
        GoSub ws2Print
    End If
    Exit Sub
    
ws2Print:
    With ws2
        .PrintPreview     '確認用
        '.Printout        '本番用
        .Range("A3,A17,A31").ClearContents
    End With
    Return
End Sub

 

回答
投稿日時: 20/01/19 22:31:20
投稿者: WinArrow
投稿者のウェブサイトに移動

基本的にsimpleさんのご意見に賛同します。
 
転記元シートと転記先シートが逆になっているような気がします。
 
転記元シートがアクティブになっている前提のコードなので
転記元シートで修飾した形のコードを掲示します。
 

Option Explicit

Sub 印刷1()
    Dim ws1 As Worksheet, ws2 As Worksheet
    Dim LastRow As Long
    Dim i As Long
    Dim k As Long

    Set ws1 = Worksheets("3回確認")
    Set ws2 = Worksheets("3回実施")

    With ws1
        LastRow = .Cells(.Rows.Count, 5).End(xlUp).Row
        For i = 6 To LastRow
            If .Cells(i, 5).Value = "印刷" Then
                k = k + 1
                Select Case k Mod 3
                    Case 1: ws2.Range("A3").Value = .Cells(i, 4).Value
                    Case 2: ws2.Range("A17").Value = .Cells(i, 4).Value
                    Case 0
                        ws2.Range("A31").Value = .Cells(i, 4).Value
                        GoSub ws2Print
                End Select
            End If
        Next i
    End With
    If k Mod 3 <> 0 Then  'まだ印刷していない箇所を印刷。(落ち穂拾い)
        GoSub ws2Print
    End If
    Set ws1 = Nothing
    Set ws2 = Nothing
    Exit Sub
    
ws2Print:
    With ws2
        .PrintPreview     '確認用
        '.Printout        '本番用
        .Range("A3,A17,A31").ClearContents
    End With
    Return
End Sub


 
 

回答
投稿日時: 20/01/20 00:06:10
投稿者: simple

フォローありがとうございます。
ワークシート名は余り考えていませんでした。
要するに、データシートと印刷用シートです。
データシートから印刷用シートに転記して、印刷するってことですね。
 
理解のためにこんなメモが参考になりますか?

         E列        k       kを3で割った余り
 6行目   印刷       1       1
 7                       
 8       印刷       2       2
 9       印刷       3       0    →ここで、印刷
10       印刷       4       1
11       印刷       5       2
12                       
13       印刷       6       0    →ここで印刷
14       印刷       7       1

                          ループを抜けたあと、k Mod 3 が1 なので、
                          まだ印刷できていないものがある。
                          そこで、それを印刷する。

回答
投稿日時: 20/01/20 09:55:38
投稿者: mattuwan44

印刷したいデータは、E列に「印刷」と入っている。
ならば、印刷しないデータはE列にどういう値が入っているのでしょう?
空白でいいのかな?
 
僕はそういう場合は、
印刷したいデータは、1
印刷しないデータは、空白
としてます。
印刷する目印はなんでもいいですが、
入力しやすさ優先ですね。
 

┌──┬──┬────────┬───────┬──────────┐
│印刷│氏名│住所            │車種          │番号                │
├──┼──┼────────┼───────┼──────────┤
│    │内田│島根県出雲市    │大型貨物自動車│島根 100 か **** │
├──┼──┼────────┼───────┼──────────┤
│    │珍部│島根県出雲市    │大型貨物自動車│福山 100 か **   │
├──┼──┼────────┼───────┼──────────┤
│    │寺本│広島県三次市    │大型貨物自動車│福山 100 か **** │
├──┼──┼────────┼───────┼──────────┤
│   1│那須│広島県広島市    │大型貨物自動車│広島 130 か **** │
├──┼──┼────────┼───────┼──────────┤
│    │西川│広島県三次市    │大型貨物自動車│福山 100 か **   │
├──┼──┼────────┼───────┼──────────┤
│    │岸本│広島県三次市    │大型貨物自動車│福山 100 は **** │
├──┼──┼────────┼───────┼──────────┤
│    │田河│広島県安佐北区  │大型貨物自動車│広島 131 か *    │
├──┼──┼────────┼───────┼──────────┤
│   1│前谷│広島県安芸高田市│大型貨物自動車│福山 100 か **** │
└──┴──┴────────┴───────┴──────────┘

 
 
Option Explicit

Sub test()
    Dim Rng As Range
    Dim r As Range

    With Worksheets("一覧").Range("A1").CurrentRegion
        Set Rng = Intersect(.Cells, .Offset(1), .Columns(1).SpecialCells(xlCellTypeConstants).EntireRow)
    End With
    Worksheets(Array("申請書", "申請区間")).Select

    For Each r In Rng.Rows
        With Worksheets("申請書")
            Application.StatusBar = r.Cells(2).Value & "を出力中..."
            .Range("K15").Value = r.Cells(3).Value
            .Range("K17").Value = r.Cells(2).Value
            .Range("E19").Value = r.Cells(4).Value
            .Range("N19").Value = r.Cells(5).Value
            Macro1 .Range("N19").Value
        End With
    Next
    Application.StatusBar = False
End Sub

Sub Macro1(ByVal sName As String)
    Dim sPath As String

    sPath = CreateObject("WScript.Shell").SpecialFolders("Desktop")

    On Error GoTo ErrH
    
    ActiveSheet.ExportAsFixedFormat _
            Type:=xlTypePDF, _
            Filename:=sPath & "\" & sName & ".pdf", _
            Quality:=xlQualityStandard, _
            IncludeDocProperties:=True, _
            IgnorePrintAreas:=False, OpenAfterPublish:=False
    On Error GoTo 0
    Exit Sub
    

ErrH:
    Application.Wait [Now() + "0:00:00.5"]
    Resume
End Sub

 
サンプルは、PDFファイルに出力してます。
参考になれば。
 
3行を一度に転記するなら、
3行おきに3行分処理してもいいかもですよ?
繰返しはいつでも作れるので、
とりあえず、最初の3行だけ作ってみては?

投稿日時: 20/01/20 14:15:11
投稿者: ひっちん1

mattuwan44さん
WinArrowさん
simpleさん
  
ご指導・ご教授ありがとうございます。
 
説明が下手な質問に、いろいろとご尽力いただきまして
何とか、意図するように動くようになりました。
 
感謝しております。
 
今後ともよろしくお願いします。
 
ありがとうございました。