Results of 1 - 1 of about 296 for 差し込み印刷 (0.002 sec.)
- [[20171221161805]]
- #score: 8241
- @digest: 42a91a0e2551e23a45c59bceb2e89c23
- @id: 75122
- @mdate: 2017-12-30T10:34:02Z
- @size: 38331
- @type: text/plain
- #keywords: 義シ (271277), 義") (87290), 刷始 (77615), 力sh (72519), 力列 (70424), 入先 (63369), 記= (61204), 先") (29682), 「記 (23287), 先シ (19968), myrange (18447), 出力 (18339), 先」 (18143), 記入 (17960), 列変 (17302), 度」 (15619), 可視 (15121), 年度 (14893), 業シ (13767), 印刷 (12844), 区分 (12808), 「○ (12044), printpreview (10859), 定義 (9843), 視セ (9756), の転 (8916), 転記 (8889), 契約 (7723), 列= (6986), cells (6671), シー (6276), ート (5528)
- 『オートフィルタで抽出したデータを、別シートの特定セルに貼りつけたい』（まっくん）
いつもお世話位なっております、まっくんです。 表題の通りの質問なのですが、仮に シート1で Range("A1").AutoFilter Field:=1, Criteria1:="○" で、オートフィルタをかけたとします。 この際の可視セルがA1〜J1セル、D1セル〜J1セルになり、B1〜J1は非可視になるとします。 この状態で、シート2の規則的なセルへデータをコピーしたいと考えています。 具体的には シート1のA1セル⇒シート2のD1セル シート1のA5セル⇒シート2のD2セル シート1のA6セル⇒シート2のD4セル シート1のC1セル⇒シート2のE1セル シート1のC5セル⇒シート2のE2セル シート1のC6セル⇒シート2のE4セル ・ ・ ・ といった感じです。 実際にはR1C1形式（cells）で書いており、ループ文等で規則的な貼り付けを実施したいと考えています。 ただ、do while文やFor文で書くと、非可視セルまでデータを取ってしまうので使えません（よね・・・）。 可視セルのみをコピーするやり方は調べればあったのですが、可視セルをそのまま別シートにコピーするというのはわかりましたが、このようにセル単位でコピーする方法がわかりませんでした。 何か良い知恵をお貸ししていただけませんでしょうか。 コードがなくて申し訳ありませんが、よろしくお願いします。 ＜ 使用 Excel:Excel2010、使用 OS:Windows7 ＞ ---- ＞ この際の可視セルがA1〜J1セル、D1セル〜J1セルになり、B1〜J1は非可視になるとします。 A列でフィルタした場合ですよね? 非表示になるのは列じゃなくて、行では? この一文では、さっぱり意味が判りません。 とりあえず、マクロならば、Rows(1).Hidden を調べれば、行が非表示になっているか判定できるので、全行ループしつつ、表示されているものだけ処理するコーディングにできる事でしょう。 （???） 2017/12/21(木) 17:28 ---- ＞シート2の規則的なセルへデータをコピーしたいと考えています。 提示された例からは、規則性が理解できません。 ＞このようにセル単位でコピーする方法がわかりませんでした。 A列でフィルタ、 B列セルを1セルずつ取り出す例 Option Explicit Sub test() Dim r As Range Dim c As Range Dim n As Long With Sheets("sheet1").Range("a1").CurrentRegion .AutoFilter Field:=1, Criteria1:="○" Set r = .Columns(2).SpecialCells(xlCellTypeVisible) .AutoFilter End With For Each c In r MsgBox c.Value Next End Sub （マナ） 2017/12/21(木) 18:31 ---- ＞Range("A1").AutoFilter Field:=1, Criteria1:="○" ＞で、オートフィルタをかけたとします。 ＞この際の可視セルがA1〜J1セル、D1セル〜J1セルになり、B1〜J1は非可視になるとします。 私も↑の部分がよく理解できませんでした。 オートフィルタしただけなら行単位で可視/不可視になるだけですよね さらに、セル範囲「A1〜J1」に「D1〜」も「B1〜」も内包されてますから意味が通じないです。 ＞可視セルのみをコピーするやり方は調べればあったのですが、可視セルをそのまま別シートに ＞コピーするというのはわかりましたが、このようにセル単位でコピーする方法がわかりませんでした。 可視セルとセル単位の違いもよくわからないですけど単純に作業シートとして新規シート追加して、フィルタ結果を貼り付け、欲しいデータとったら、作業シートを削除 でどうですか? （もこな2） 2017/12/22(金) 01:57 ---- こにちわ、まっくんです。 すいません、かなり抽象的な書き方をしてしまい、皆様をご混乱させつぃまいまして申し訳ございません。 いま、私がやりたいことは、 まず「定義」というシートと「記入先」というシートがあります。 定義シートA列は「印刷」という表題で、A2以降には「○」が入ったり入らなかったります。 定義シートB列は「区分」という表題で、B2以降にh「AやB」といったアルファベットが1文字入ります。 定義シートC列は「年度」という表題で、B2以降にh「28年度」や「29年度」といった年度の文字列が入ります。 ここで、VBAでA列で「○」がついている、行の「区分」・「年度」を「記入先」シートに転記して、最終的には印刷したいのです。 定義シートのひとつ目に「○」が見つかった行の「区分」は記入先シートのA1へ必ず記載します。 定義シートのひとつ目に「○」が見つかった行の「年度」は記入先シートのA2へ必ず記載します。 次に、定義シートのふたつ目に「○」が見つかった行の「区分」は記入先シートのB1へ必ず記載します。 定義シートのふたつ目に「○」が見つかった行の「年度」は記入先シートのB1へ必ず記載します。 ・この時点で印刷をします。 （本当なら、ここで「記入先」シートのデータを消したいのですが割愛します） 次に、定義シートのみっつ目に「○」が見つかった行の「区分」は記入先シートのA1へ必ず記載します。 定義シートのみっつ目に「○」が見つかった行の「年度」は記入先シートのA2へ必ず記載します この時点で印刷をします。 次に、定義シートのよっつ目に「○」が見つかった行の「区分」は記入先シートのB1へ必ず記載します。 定義シートのよっつ目に「○」が見つかった行の「年度」は記入先シートのB2へ必ず記載します ・この時点で印刷をします。 ・ ・ ・ この繰り返し処理となります。 以下のようなマクロを作成しました。 幸いスレッドのタイトルに関しましては、???様の ＞とりあえず、マクロならば、Rows(1).Hidden を調べれば、行が非表示になっているか判定できるので、全＞行ループしつつ、表示されているものだけ処理するコーディングにできる事でしょう。 で解決いたしました・・・が、記入先への転記でFor分を重ねているため、転記がうまくいっていません。 記入先シートのA列とB列に、定義シートで見つかった一つ目の行の「○」の値が書き込まれた後、次に定義シートで見つかった二つ目の行の「○」の値が書き込まれます。 本来であれば、私の頭の中では「定義シート」の○が見つかった1行目の「区分」が「記入先」シートのA1へ、次に「年度」がA2へ転記され・・・ 次に、「定義シート」の○が見つかった2行目の「区分」が「記入先」シートのB1へ、次に「年度」がB2へ転記され・・・ 次に、3つ目に見つかったものは、A1、A2へ上書き・・・ というループを考えていました。 以下のようなマクロです Option Explicit Sub TEST3() Dim Kubun, Nendo As Range Dim i, j, KubunC, NendoC, LastRow As Long 'デバッグ用 ThisWorkbook.Worksheets("記入先").Activate With Worksheets("定義") '区分の列番号の取得 Set Kubun = .Cells.Find(What:="区分", LookAt:=xlWhole) KubunC = Kubun.Column '年度の列の列番号取得 Set Nendo = .Cells.Find(What:="年度", LookAt:=xlWhole) NendoC = Nendo.Column 'オートフィルタでA行の「印刷」という行に「○」がついているものを印刷する .Range("A1").AutoFilter Field:=1, Criteria1:="○" '定義シートの最終行を取得 LastRow = .Cells(Rows.Count, 1).End(xlUp).Row For i = 2 To LastRow 'もし可視セルならば処理をする If Rows(i).Hidden = False Then For j = 1 To 2 '区分の記入 Worksheets("記入先").Cells(1, j) = .Cells(i, KubunC).Value '年度の記入 Worksheets("記入先").Cells(2, j) = .Cells(i, NendoC).Value If j = 2 Then Worksheets("記入先").PrintPreview End If Next j End If Next i End With End Sub シート「定義」 印刷 区分 年度 ○ A 29 ○ B 29 - C 29 シート「記入先」 空白 かなりスレッド違いの名前の質問内容が変わってしま申し訳ないのですが、知恵をお貸し願えませんでしょうか。 かなり稚拙なマクロをお見せし、長文になってしまい申し訳ございません。 （まっくん） 2017/12/22(金) 14:26 ---- すいません、若干間違えがあったので書き直します。 こにちわ、まっくんです。 すいません、かなり抽象的な書き方をしてしまい、皆様をご混乱させつぃまいまして申し訳ございません。 いま、私がやりたいことは、 まず「定義」というシートと「記入先」というシートがあります。 定義シートA列は「印刷」という表題で、A2以降には「○」が入ったり入らなかったります。 定義シートB列は「区分」という表題で、B2以降にh「AやB」といったアルファベットが1文字入ります。 定義シートC列は「年度」という表題で、B2以降にh「28年度」や「29年度」といった年度の文字列が入ります。 ここで、VBAでA列で「○」がついている、行の「区分」・「年度」を「記入先」シートに転記して、最終的には印刷したいのです。 定義シートのひとつ目に「○」が見つかった行の「区分」は記入先シートのA1へ必ず記載します。 定義シートのひとつ目に「○」が見つかった行の「年度」は記入先シートのA2へ必ず記載します。 次に、定義シートのふたつ目に「○」が見つかった行の「区分」は記入先シートのB1へ必ず記載します。 定義シートのふたつ目に「○」が見つかった行の「年度」は記入先シートのB1へ必ず記載します。 ・この時点で印刷をします。 （本当なら、ここで「記入先」シートのデータを消したいのですが割愛します） 次に、定義シートのみっつ目に「○」が見つかった行の「区分」は記入先シートのA1へ必ず記載します。 定義シートのみっつ目に「○」が見つかった行の「年度」は記入先シートのA2へ必ず記載します この時点で印刷をします。 次に、定義シートのよっつ目に「○」が見つかった行の「区分」は記入先シートのB1へ必ず記載します。 定義シートのよっつ目に「○」が見つかった行の「年度」は記入先シートのB2へ必ず記載します ・この時点で印刷をします。 ・ ・ ・ この繰り返し処理となります。 以下のようなマクロを作成しました。 幸いスレッドのタイトルに関しましては、???様の ＞とりあえず、マクロならば、Rows(1).Hidden を調べれば、行が非表示になっているか判定できるので、全＞行ループしつつ、表示されているものだけ処理するコーディングにできる事でしょう。 で解決いたしました・・・が、記入先への転記でFor分を重ねているため、転記がうまくいっていません。 記入先シートのA列とB列に、定義シートで見つかった一つ目の行の「○」の値が書き込まれた後、次に定義シートで見つかった二つ目の行の「○」の値が書き込まれます。 本来であれば、私の頭の中では「定義シート」の○が見つかった1行目の「区分」が「記入先」シートのA1へ、次に「年度」がA2へ転記され・・・ 次に、「定義シート」の○が見つかった2行目の「区分」が「記入先」シートのB1へ、次に「年度」がB2へ転記され・・・ 次に、3つ目に見つかったものは、A1、A2へ上書き・・・ というループを考えていました。 以下のようなマクロです Option Explicit Sub TEST3() Dim Kubun, Nendo As Range Dim i, j, KubunC, NendoC, LastRow As Long 'デバッグ用 ThisWorkbook.Worksheets("記入先").Activate Cells.Clear With Worksheets("定義") '区分の列番号の取得 Set Kubun = .Cells.Find(What:="区分", LookAt:=xlWhole) KubunC = Kubun.Column '年度の列の列番号取得 Set Nendo = .Cells.Find(What:="年度", LookAt:=xlWhole) NendoC = Nendo.Column 'オートフィルタでA行の「印刷」という行に「○」がついているものを印刷する .Range("A1").AutoFilter Field:=1, Criteria1:="○" '定義シートの最終行を取得 LastRow = .Cells(Rows.Count, 1).End(xlUp).Row For j = 1 To 2 For i = 2 To LastRow 'もし可視セルならば処理をする If Rows(i).Hidden = False Then '区分の記入 Worksheets("記入先").Cells(1, j) = .Cells(i, KubunC).Value '年度の記入 Worksheets("記入先").Cells(2, j) = .Cells(i, NendoC).Value End If Next i Next j End With End Sub シート「定義」 印刷 区分 年度 ○ A 28 ○ B 29 ● C 30 シート「記入先」 空白 かなりスレッド違いの名前の質問内容が変わってしま申し訳ないのですが、知恵をお貸し願えませんでしょうか。 かなり稚拙なマクロをお見せし、長文になってしまい申し訳ございません。 （まっくん） 2017/12/22(金) 14:49 ---- 度々すいません。 まくrの一文が間違っていましたので、マクロのみ再送させていただきます。 Option Explicit Sub TEST3() Dim Kubun, Nendo As Range Dim i, j, KubunC, NendoC, LastRow As Long 'デバッグ用 ThisWorkbook.Worksheets("記入先").Activate Cells.Clear With Worksheets("定義") '区分の列番号の取得 Set Kubun = .Cells.Find(What:="区分", LookAt:=xlWhole) KubunC = Kubun.Column '年度の列の列番号取得 Set Nendo = .Cells.Find(What:="年度", LookAt:=xlWhole) NendoC = Nendo.Column 'オートフィルタでA行の「印刷」という行に「○」がついているものを印刷する .Range("A1").AutoFilter Field:=1, Criteria1:="○" '定義シートの最終行を取得 LastRow = .Cells(Rows.Count, 1).End(xlUp).Row For j = 1 To 2 For i = 2 To LastRow 'もし可視セルならば処理をする If .Rows(i).Hidden = False Then '区分の記入 Worksheets("記入先").Cells(1, j) = .Cells(i, KubunC).Value '年度の記入 Worksheets("記入先").Cells(2, j) = .Cells(i, NendoC).Value End If Next i Next j End With End Sub （まっくん） 2017/12/22(金) 16:40 ---- オートフィルタの意味があるのですか 行の表示・非表示を判定しなくても A列が○かどうかを判定すればよいだけでは? （マナ） 2017/12/22(金) 17:49 ---- 読みづらかったのでちょと整理してみました ＜定義＞シート 1行目は表題部 2行目以降がデータ部 A列から順に[印刷][区分][年度] ＜記入先＞シート 1行目からデータ部 A列から順に[区分][年度] ＜やりたいこと＞（ちょっと解釈を変えてます） 「定義」のA列に〇がついているものを抽出して、B〜Cを行列を入れ替えて記入先に貼り付けて印刷 ただし、2列ごとに印刷（あとは非表示）で印刷したい ってことでしょうか? また、途中で「記入先」のデータを消したいとのコメントがあるので、印刷さえされれば「記入先」シートがどんな状態でもいいってことでしょうか? 以下はその場合のコメントですが、 作戦1 (1)「記入先」をクリア (2)オートフィルタを使ってA列に〇が入ってるのを抽出 (3)抽出されたデータを、作業シートを作成してそこにコピペ (4)作業シートの内容をコピーして「記入先」に行列入れ替えで貼り付け (5)作業シートを削除 (6)「記入先」の2列ごとに改ページを挿入 (7)印刷実行 作戦2（マナさんがコメントされてることとかぶりますが） (1)「記入先」をクリア (2)「定義」のA列を2行目から最終行まで順番に見て行って 〇がついていればB〜C列を「記入先」の1〜2行目に 列をずらしながら出力 (3)作戦1の(6)以降と一緒 このどちらかの作戦で解決されませんか? このほか細かいことですが ThisWorkbook.Worksheets("記入先").Activate Cells.Clear ここ、いったん「記入先」をアクティブにしてからClearメソッド実行してますが、アクティブにする必要はありません。 むしろ、なんかの拍子に「記入先」がアクティブになってなくても、アクティブシートの全内容をクリアしてしまうのであぶないなぁと思います。 （わかってやってるなら止めませんが） （もこな2） 2017/12/23(土) 10:56 ---- こんな感じでも、できると思います。 Option Explicit Sub test2() Dim ws As Worksheet Dim i As Long Dim 次の転記 As String Dim 印刷する As Boolean Set ws = Worksheets("定義") 次の転記 = "A" For i = 2 To 10 If ws.Cells(i, "A").Value = "○" Then MsgBox i & "行を" & 次の転記 & "列に転記" If 次の転記 = "A" Then If i = 10 Then 印刷する = True 次の転記 = "B" Else 印刷する = True 次の転記 = "A" End If If 印刷する Then MsgBox "印刷してから値クリア" 印刷する = False End If End If Next End Sub （マナ） 2017/12/23(土) 12:32 ---- ↑問題に気づきました。修正します。 （マナ） 2017/12/23(土) 15:09 ---- 修正しました。 Option Explicit Sub test3() Dim ws As Worksheet Dim i As Long Dim 次の転記 As String Dim 印刷する As Boolean Set ws = Worksheets("定義") 次の転記 = "A" For i = 2 To 10 If ws.Cells(i, "A").Value = "○" Then MsgBox i & "行を" & 次の転記 & "列に転記" If 次の転記 = "A" Then 次の転記 = "B" 印刷する = True Else MsgBox "印刷してから値クリア" 印刷する = False 次の転記 = "A" End If End If Next If 印刷する Then MsgBox "印刷してから値クリア" End If End Sub （マナ） 2017/12/23(土) 15:20 ---- こんにちわ、まっくんです。 返信が遅れて大変申し訳ございません。 ここまで丁寧に教えていただいているのですが、やはりうまくいきません。 もこな2様のおっしゃっているのは、「○」のついている行を「1行づつ、作業シートへコピーする」ということでしょうか? この場合でも、可視行の 「i行目の情報を行列変換する」で、複数行にまたがってループでコピーする際うまくいきません。（私の例では3行でしたが、これが1000行あると考えてください） マナ様の例だと、すいません、私の頭では理解ができませんでした。 大変厚かましいようですが、実際のシートコピーをどのようにするかご教授願えませんでしょうか。 スキル不足でご迷惑をおかけいたしまして申し訳ありません。 よろしくお願い申し上げます。 （まっくん） 2017/12/26(火) 15:14 ---- すいませんが追記させてください。 こちらで、色々話をしていて、最終的にはこういう形にしたいということになりました。 転記元 ワークシート名 「定義」 区分 年度 書類名 重要度 印刷 A 25 契約 1 ○ A 28 参考 1 B 29 契約 3 ○ A 30 契約 2 ○ C 29 参考 1 ○ A 29 資料 3 ・ ・ ・ 行数不確定 転記先 ワークシート名 「記入先」 A 1 B 1 A 列 列 契約 あ 契約 あ 契約 1 け 3 け 2 ○ る ○ る ○ という形になり、「記入先」ワークシートには「年度」を入れなくなります。（ただし、「定義」ワークシートにはDB的な意味で残しておきたい） そして、「記入先」ワークシートで、3列分転記入力されると、データを印刷した後、データをクリアし、再度「定義」ワークシートから同様に○のついている行のデータを上記の表のように転記させ印刷、データクリア・・・といった流れになります。 すいませんが、知恵をお貸し願えませんでしょうか・・・。 （まっくん） 2017/12/26(火) 16:08 ---- 2017/12/26(火) 15:14の投稿への返答です。 失礼しました。 しばらくフォローしてなかったので、質問が来てるのに気づきませんでした。 ＞もこな2様のおっしゃっているのは、「○」のついている行を「1行づつ、作業シートへコピーする」 ＞ということでしょうか? 違います。 作戦1はオートフィルターを使う代わりに作業シートを利用します。 作戦2は「○」のついている行を1行づつ読み取って行列を入れ替えた上で「記入先」シートに行をずらしながら直接出力します。 ＞この場合でも、可視行の ＞「i行目の情報を行列変換する」で、複数行にまたがってループでコピーする際うまくいきません。 ＞（私の例では3行でしたが、これが＞1000行あると考えてください） どちらの作戦で、どのようにうまくいかないのか、の情報がないので回答できません。 （1000列を2列ずつ改ページ入れていくという処理を考えると、エラーが出そうな気も しますが、どのようなエラーが発生しているのか、確認してからでも遅くはないと おもいますので今回は説明を割愛します。） （もこな2） 2017/12/26(火) 18:11 ---- すみません。上記投稿でミスりました。 誤 「記入先」シートに行をずらしながら直接出力します。 正 「記入先」シートに列をずらしながら直接出力します。 （もこな2） 2017/12/26(火) 18:16 ---- こんにちわ、まっくんです。 もこな2様、とりあえず稚拙で出来損ないのマクロを組んで、うまくいっていません。 定義シート 区分 年度 書類名 重要度 印刷 A 25 契約 1 ○ A 28 参考 1 B 29 契約 3 ○ A 30 契約 2 C 29 参考 1 ○ A 29 資料 3 他、「記入先」シート⇒空白 「作業シート」⇒空白 からスタートします。 Option Explicit Sub TEST3() Dim Kubun, Nendo As Range Dim i, j, KubunC, NendoC, LastRow, LastCol As Long Dim WS, WS2, WS3 As Worksheet Set WS = Worksheets("定義") Set WS2 = Worksheets("記入先") Set WS3 = Worksheets("作業シート") With WS '定義シートの最終行を取得 LastRow = .Cells(Rows.Count, 1).End(xlUp).Row '定義シートの最終列を取得 LastCol = .Cells(1, Columns.Count).End(xlToLeft).Column For i = 1 To LastRow If .Cells(i, 5) = "○" Then .Range(.Cells(i, 2), .Cells(i, LastCol)).Copy WS3.Cells(1, i).PasteSpecial _ Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:=False, Transpose:=True Application.CutCopyMode = False For j = 1 To 6 Step 2 WS2.Cells(2, j) = WS3.Cells(1, i) WS2.Cells(3, j).Offset(1, 0) = WS3.Cells(2, i) Next j End If Next i End With End Sub 問題点1:まず、作業シートで、定義シートに「○」がついていないところは行が空白になります。 25 29 29 契約 契約 参考 1 3 1 ○ ○ ○ のような感じで、間にセルが入ってしまいます。 問題点2: 上記のマクロを走らせると、 29 29 29 参考 参考 参考 という形で、記入先シートには出力されてしまいます。（最後に○がついている行のみ出力されている） 問題がどこにあるかはわかっています。 ただ、それをマクロで書くとどうなるのかが全く分かりません。 問題点1:の問題は For i = 1 To LastRow が回るため、 If .Cells(i, 5) = "○" に引っかからなくても、空白が1列空いてしまうためです。 問題点2:の問題は For j = 1 To 6 Step 2 WS2.Cells(2, j) = WS3.Cells(1, i) WS2.Cells(3, j).Offset(1, 0) = WS3.Cells(2, i) Next j は For i = 1 To LastRow 内にあるため、最終的な値のみ、記入先シートには記載されてしまいます。 という問題点把握を自分なりにしています。 すいません、解決方法はありますでしょうか・・・。 何度もすいませんが、教えていただけませんでしょうか。 よろしくお願い申し上げます。 （まっくん） 2017/12/27(水) 12:23 ---- 本題と違いますが、 ＞Dim WS, WS2, WS3 As Worksheet ↑は記述の仕方間違っています。 ＞すいません、私の頭では理解ができませんでした。 わたしの案は、もこな2さんのと違って効率悪いかもしれませんが たぶん、印刷が律速になると思うので、処理速度は求めませんよね? なので、単純に全行を1行ずつ調べながら転記するというものです。 で、1行転記するごとに、「次の転記」先A→C→Eと変えています。 印刷データがちょうど3の倍数でない場合にも、 印刷されないで終わると困るので、 変数「印刷する」で判断できるようにしています。 変数を使わずに、「A1セルが空白でないなら印刷」 というのでもOKです。 Sub test3() Dim ws As Worksheet, ws2 As Worksheet Dim i As Long Dim 次の転記 As String Dim 印刷する As Boolean Set ws = Worksheets("定義") Set ws2 = Worksheets("記入先") 次の転記 = "A" For i = 2 To ws.Cells(Rows.Count, "A").End(xlUp).Row If ws.Cells(i, "E").Value = "○" Then ws2.Cells(1, 次の転記).Value = ws.Cells(i, "C").Value ws2.Cells(2, 次の転記).Value = ws.Cells(i, "D").Value If 次の転記 = "A" Then 印刷する = True 次の転記 = "C" ElseIf 次の転記 = "C" Then 印刷する = True 次の転記 = "E" Else ws2.PrintPreview ws2.Range("A1:A2,C1:C2,E1:E2").ClearContents 印刷する = False 次の転記 = "A" End If End If Next If 印刷する Then ws2.PrintPreview ws2.Range("A1:A2,C1:C2").ClearContents End If End Sub （マナ） 2017/12/27(水) 20:34 ---- ＞「A1セルが空白でないなら印刷」 このほうが、わかりやすいし、よかったかもしれません。 Sub test4() Dim ws As Worksheet, ws2 As Worksheet Dim i As Long Dim 次の転記 As String Set ws = Worksheets("定義") Set ws2 = Worksheets("記入先") 次の転記 = "A" For i = 2 To ws.Cells(Rows.Count, "A").End(xlUp).Row If ws.Cells(i, "E").Value = "○" Then ws2.Cells(1, 次の転記).Value = ws.Cells(i, "C").Value ws2.Cells(2, 次の転記).Value = ws.Cells(i, "D").Value If 次の転記 = "A" Then 次の転記 = "C" ElseIf 次の転記 = "C" Then 次の転記 = "E" Else ws2.PrintPreview ws2.Range("A1:A2,C1:C2,E1:E2").ClearContents 次の転記 = "A" End If End If Next If ws2.Range("A1").Value <> "" Then ws2.PrintPreview ws2.Range("A1:A2,C1:C2").ClearContents End If End Sub （マナ） 2017/12/27(水) 20:44 ---- 2017/12/26(火) 16:08の投稿に対する返答です う〜ん。「年度」も出力しないし、1列おきに出力したいということですよね。 そうなるともう、オートフィルターをなんやかんやしてって考えはやめて、印刷フラグがたってる行を拾ってコピーするっていう方法（=マナさんや、私が書いた作戦2のようなやり方）がよいように思います。 ちなみに、まっくんさんは配列ってわかりますか? もしわかるのであれば、下記のようなやり方もありますので、検討してみてください。 ※ちなみに3アイテムごとに印刷っていうのが意外と難しくて悩んでます。 （出来ないわけじゃ無いんですが、どうにも美しくない。。。） まぁとりあえず提供します。（出力処理までテスト済み、印刷は未チェック） Sub Sample() '==変数宣言とか Dim 配列変数() As String Dim i As Long, c As Integer Dim Wf As Object Set Wf = Application.WorksheetFunction '==データの取込(「定義」シートのE列が「○」なら配列変数に格納) With Worksheets("定義") If Not Wf.CountIf(.Range("E:E"), "○") >= 1 Then Exit Sub ReDim 配列変数(Wf.CountIf(.Range("E:E"), "○"), 3) c = 0 'カウンタを0にセット（配列変数の第1要素のカウンタとして使用） For i = 2 To .Cells(.Rows.Count, "E").End(xlUp).Row If .Cells(i, "E") = "○" Then 配列変数(c, 0) = .Range("A" & i).Value 配列変数(c, 1) = .Range("C" & i).Value 配列変数(c, 2) = .Range("D" & i).Value 配列変数(c, 3) = .Range("E" & i).Value c = c + 1 End If Next i End With '==データの出力(と印刷) With Worksheets("記入先") '--出力処理 .Cells.Clear '「記入先」シートの全セルをクリア c = 1 'カウンタを1にリセット（列番号として使用） For i = 0 To UBound(配列変数, 1) .Cells(1, c).Value = 配列変数(i, 0) .Cells(2, c).Value = 配列変数(i, 1) .Cells(3, c).Value = 配列変数(i, 2) .Cells(4, c).Value = 配列変数(i, 3) c = c + 2 Next i '--印刷処理 '6列セットの印刷を何回繰り返せば良いかを計算 '考え方:1列目〜 （配列変数の第1要素に格納されているアイテム数 ×2 ）列目までが印刷範囲 ' これを6列ずつ印刷 なので 上記を6で除して切り上げが印刷回数 For i = 0 To Application.RoundUp(((UBound(配列変数, 1) + 1) * 2) / 6) - 1 .Range(.Column(1 + (i * 6)), .Column(6 + (i * 6))).PrintOut Next i End With End Sub （もこな2） 2017/12/27(水) 22:57 ---- 2017/12/27(水) 12:23の投稿に対する返信です。 ざっと流し読みしましたけど、 (1) オートフィルタ使わないなら作業シートは要らないです。 (2) For〜Next のなかに If .Cells(i, 5) = "○" Then .Range(.Cells(i, 2), .Cells(i, LastCol)).Copy WS3.Cells(1, i).PasteSpecial _ Paste:=xlPasteAll, Operation:=xlNone, _ SkipBlanks:=False, Transpose:=True Application.CutCopyMode = False ってあるので、「○」じゃないやつがでもiが進んじゃうから歯抜けデータが 完成するんじゃないかとおもいます。（ご自身でも気づかれているようですが） (3) 問題点2のほうは、(1)のとおり作業シート要らないって考えれば問題解決しません? とりあえず、いくつかの私の回答まとめると、 (1)オートフィルタを使うんじゃ無くて、E列に○が付いてるということを条件に処理したらよさそう (2)3アイテムコピーして、印刷して、クリアしてを繰り返すより、一度出力してから3アイテムごとに印刷したほうがよさそう（コードの書きやすさや考え方の面で） って思いました。 もちろんやり方はいろいろありますので、ご自身に合ったやり方を見つけてください。 このほか、余談ですけど、「○」がついてればって処理ってある意味危険ですよ。入力を他の人にお願いする場合や、他の方にマクロ付きブックを引き継ぐ場合、数字の0を全角で入れてくる人や、●や◎入れてくる人もいるかもしれないので、将来的には、ブランクじゃななきゃ処理する〜みたいな感じに修正されたほうがいいかもしれません。 他の掲示板でちょっと話題になったことがありましたので、ご参考まで。 （もこな2） 2017/12/27(水) 23:20 ---- マナ様、もこな2様、コメントありがとうございます! まっくんです。 今からコメントマクロの方を解析させていただきつつ勉強させていただきます。 また、わなからないところがあれば（たぶんあるでしょう・・・）ご質問をさせていただくことをご容赦ください。 （まっくん） 2017/12/28(木) 09:19 ---- ＞また、わなからないところがあれば（たぶんあるでしょう・・・）ご質問をさせていただくことをご容赦ください。 気がつけばわかる範囲で回答いたしますが、ご覧のように遅レスなのでその辺はご容赦を。 また、配列を使わない&印刷処理でもうちょっとマシな方法を思いついたので追加投稿します。 コードの下に簡単な解説つけときました。 Sub Sample2() '==前処理（変数宣言とか） Dim 出力列 As Long, 印刷始 As Long Dim MyRange As Range Dim 出力SH As Worksheet Set 出力SH = Worksheets("記入先") 出力SH.Cells.Clear '--(1) '==主処理1（抽出&コピー） With Worksheets("定義") 出力列 = 1 '--(2) For Each MyRange In .Range(.Cells(2, "E"), .Cells(.Rows.Count, "E").End(xlUp)) '--(3) If MyRange.Value <> "" Then '--(4) .Cells(MyRange.Row, "A").Copy 出力SH.Cells(1, 出力列) .Cells(MyRange.Row, "C").Copy 出力SH.Cells(2, 出力列) .Cells(MyRange.Row, "D").Copy 出力SH.Cells(3, 出力列) .Cells(MyRange.Row, "E").Copy 出力SH.Cells(4, 出力列) 出力列 = 出力列 + 2 '--(5) End If Next MyRange End With '==主処理2（印刷） With 出力SH 印刷始 = 1 Do Until 印刷始 > .Cells(1, .Columns.Count).End(xlToLeft).Columns '--(6) .Range(.Columns(印刷始), .Columns(印刷始 + 5)).PrintOut 印刷始 = 印刷始 + 6 Loop End With '==後処理（省略可能） Set MyRange = Nothing Set 出力SH = Nothing End Sub （1）ここで、「記入先」シートの全セルをクリアしています。 （2）ループの外側で変数「出力列」の初期値をセットしています。 （3）For Eachで「定義」シートのセル範囲「E2〜E○」を1セルずつ取り出して処理します （4）(3)で取り出したセルの値がブランクで無ければ処理行うという意味になります。 （5）変数「出力列」に（1列おきだから）2を加算して、次のコピー処理に備えます （6）変数「印刷始」が「記入先」シートの（1行目の）最終列を超えるまで印刷を繰り返します （もこな2） 2017/12/28(木) 11:19 ---- こんにちわ、まっくんです。 もこな2様、大変厚かましい質問なのですが、両マクロともある程度頑張って理解しようとしましたが、両マクロとも、 私の要望でした 「3列分印刷したのち、データをクリアして、再度3列分転記して印刷・・・（以下繰り返し」 というのができていないような気がします・・・。 マクロを動作させてみたところ、転記したデータは右にどんどん流れて行っているように見受けられました。（印刷自体は1ページに3列分というようにはなっていましたが・・・） 仮に定義シートのE列にブランク以外が1000行ほどあると対応できないのではないでしょうか・・・。 どこかで、 1.記入先シートをクリア 2.印刷始を1に戻す という処理が必要になってくるのではないでしょうか。 すいません、私の考えちがえでしたら申し訳りません。 よろしくお願い申し上げます。 （まっくん） 2017/12/28(木) 13:55 ---- ＞仮に定義シートのE列にブランク以外が1000行ほどあると対応できないのではないでしょうか・・・。 エクセル2007よりまえのバージョンであればそうですね。 エクセル2007以降は列数が16,384列に拡張されましたので、1000アイテム ×2（1列おき）でも大丈夫でしょう ＞1.記入先シートをクリア ＞2.印刷始を1に戻す ＞という処理が必要になってくるのではないでしょうか。 もちろん、そういった考え方もあるとおもいます。 このスレッドにあるヒントで実現可能とおもわれますので、頑張ってご自身で作ってみましょう。 （もこな2） 2017/12/28(木) 14:44 ---- 追加コメントです 細部まで見てませんけど、マナさんのtest4は、ご希望の動作になりそうな気がします。 研究してみては、いかがでしょう （もこな2） 2017/12/28(木) 15:02 ---- こんにちわ、まっくんです。 コメントありがとうございます。 おっしゃるとおりで、かなりヒントは頂いているともいます。 できるだけ頑張ってみます! （まっくん） 2017/12/28(木) 16:05 ---- こんにちわ、まっくんです。 Sub Sample2() '==前処理（変数宣言とか） Dim 出力列 As Long, 印刷始 As Long Dim MyRange As Range Dim 出力SH As Worksheet Set 出力SH = Worksheets("記入先") 出力SH.Cells.Clear '--(1) '==主処理1（抽出&コピー） With Worksheets("定義") 出力列 = 1 '--(2) For Each MyRange In .Range(.Cells(2, "E"), .Cells(.Rows.Count, "E").End(xlUp)) '--(3) If MyRange.Value <> "" Then '--(4) .Cells(MyRange.Row, "A").Copy 出力SH.Cells(1, 出力列) .Cells(MyRange.Row, "C").Copy 出力SH.Cells(2, 出力列) .Cells(MyRange.Row, "D").Copy 出力SH.Cells(3, 出力列) .Cells(MyRange.Row, "E").Copy 出力SH.Cells(4, 出力列) 出力列 = 出力列 + 2 '--(5) If 出力列 = 7 Then 出力SH.PrintPreview 出力列 = 1 出力SH.Cells.Clear End If End If Next MyRange End With ヒントをたくさんいただきまして、上記でうまくいった（様な気がします）とおもいます。 今から、色々と入ったDBに展開して、うまくいくかどうかを検証してみます! （まっくん） 2017/12/28(木) 16:37 ---- 3で割り切れない数、見つかったらどうするんです? そのあたりのヒント、マナさんがコメントしておられますよ。 （もこな2） 2017/12/28(木) 18:12 ---- こんばんわ、まっくんです。 マナ様のマクロはなんとかステップインしながら理解できました。 もこな2さんの指摘の「3で割り切れない」というのは、つまり出力列が「3」や「5」で終わってしまう場合、私のやり方だと印刷されないということですよね（とステップインしながら勝手に判断しました） もし私の解釈が的を得ているならば、確かに、 出力列が3でも5でも印刷されるような工夫をしないといけませんね。 で、その工夫を考えています。 少し頭を柔軟にして、マナ様のマクロも参考にさせて頂き、考えてみます。 （まっくん） 2017/12/29(金) 01:01 ---- ＞もこな2さんの指摘の「3で割り切れない」というのは、つまり出力列が「3」や「5」で終わって ＞しまう場合、私のやり方だと印刷されないということですよね（とステップインしながら勝手に ＞判断しました） ＞もし私の解釈が的を得ているならば、確かに、 ＞出力列が3でも5でも印刷されるような工夫をしないといけませんね。 ＞で、その工夫を考えています。 そうです。 マナさんが投稿された 2017/12/27(水) 20:34 のコメントと 2017/12/27(水) 20:44 のコードにヒントというか答えがあるとおもいますので、確認されてはいかがでしょうか。 （もこな2） 2017/12/29(金) 10:57 ---- こんばんわ、まっくんです。 一応下記のマクロでうまくいっている（様子）です(^^; Sub Sample2() Dim 出力列 As Long Dim MyRange As Range Dim 出力SH As Worksheet Set 出力SH = Worksheets("記入先") 出力SH.Cells.Clear With Worksheets("定義") 出力列 = 1 For Each MyRange In .Range(.Cells(2, "E"), .Cells(.Rows.Count, "E").End(xlUp)) If MyRange.Value <> "" Then '--(4) .Cells(MyRange.Row, "A").Copy 出力SH.Cells(1, 出力列) .Cells(MyRange.Row, "C").Copy 出力SH.Cells(2, 出力列) .Cells(MyRange.Row, "D").Copy 出力SH.Cells(3, 出力列) .Cells(MyRange.Row, "E").Copy 出力SH.Cells(4, 出力列) If 出力列 = 1 Then 出力列 = 出力列 + 2 ElseIf 出力列 = 3 Then 出力列 = 出力列 + 2 Else 出力SH.PrintPreview 出力SH.Cells.Clear 出力列 = 1 End If End If Next MyRange If 出力SH.Cells(1, 1) <> "" Then 出力SH.PrintPreview 出力SH.Cells.Clear End If End With End Sub もこな2様からいただいたマクロとマナ様からいただいたマクロを組み合わせた結果です。 Next Myrangeを If 出力SH.Cells(1, 1) <> "" Then 出力SH.PrintPreview 出力SH.Cells.Clear End If の前に持ってくることに、なかなか気が付きませんでした（マナさんんがあそこまで答えを出していてくれたのに(^^;） ご指導いただきました、マナ様・もこな2様に、大変厚かましいようなご質問ですが・・・ 正解でしょうか? よろしくお願い申し上げます。 （まっくん） 2017/12/30(土) 02:48 ---- いいと思います。 わたしなら、 With Worksheets("定義")は使わないで SET 定義SH=Worksheets("定義") にするかもしれません。 努力家のようですので、もし時間があればですが、 Wordの差し込み印刷について勉強してみるのもよいと思います。 今回のようなことが、マクロを使わなくても簡単にできます。 フォーマットの変更にも対応しやすいのでオススメです。 （マナ） 2017/12/30(土) 09:47 ---- 私も提示されたコードでご希望の動作はするように見受けられますので、よろしいようにおもいます。 気になる点とすれば、ご心配されているようなE列がブランクでないものが1000件あった場合、 ・PrintPreviewだと334回「印刷」ボタンを手動で押すことになる、 ・上記が嫌でPrintOutにかえたら、それはそれで印刷されるまで 正しく抽出（印刷）された（される）のか確認する術がない ・ヒットするのがたくさんあって、その一部だけほしい場合、 フラグを立て直す必要がある。 というのが考え付きますので、本当にたくさんのデータを扱うようになりそうなときは、抽出（印刷用データ作成）と印刷実行は別工程にしたほうがいいかなぁと個人的には思います。 （もこな2） 2017/12/30(土) 10:36 ---- もこな2さま、マナさま。 こんんばんわ、まっくんです。 数日に及ぶご指導、ありがとうございました。 お正月前に一区切りついてほっとしました(^^; ＞・PrintPreviewだと334回「印刷」ボタンを手動で押すことになる、 ここは印刷ボタンとプレビューボタンを分けようと思っています。 1ページに3つの要素なので、「○」の数が3つ以上だと「プレビューできません」にしようかと思っています。 印刷ボタンを押してしまった場合ですが・・・。 もう仕方なく、その人の責任なので、ジョブを止めてもらうしかないでしょう。 ・上記が嫌でPrintOutにかえたら、それはそれで印刷されるまで 正しく抽出（印刷）された（される）のか確認する術がない 同じ動作の繰り返しなので、まず3つだけ○を入れてもらってプレビューしてもらい、様式等があっているようであれば印刷と考えています。 「定義」シート内の要素が間違っている場合は、人的ミスなので、止めようがないので仕方ないと考えています。 どうもありがとうございました!!!m(_ _)m （まっくん） 2017/12/30(土) 19:34... - https://www.excel.studio-kazu.jp/wiki/kazuwiki/201712/20171221161805.txt - [detail] - similar
PREV
NEXT
Powered by Hyper Estraier 1.4.13, with 97048 documents and 608235 words.
訪問者：