[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]
『エクセルのマクロを使用して連続印刷するコード』(JIN)
エクセルのマクロでマクロを使った連続印刷について
印刷該当データでフィルタをした状態
(フィルタをしているので10行目から始まったり、次が15行目だったりまちまちになります)
「S列」が同じ「文字単位のデータ」
(同じ文字単位は、最大で5行・最小で1行つづきます。)
(文字単位のデータは、「1RG8T」や「12345」の様な5桁の「数字」「英数字込」「英字」だけの文字になります)
B列〜AH列までをコピーして別シートに値貼付
(貼付は、印刷設定をしているシートに張り付ける形になります。)
張付たデータを印刷⇒データクリア⇒元データに戻り⇒先ほどコピーした「文字単位のデータ」の次の行から同じように連続印刷する様なマクロは可能でしょうか?
1行目から5行目までが「1RG8T」で6行目が「12345」なら
最初に「1RG8T」の5行目までを印刷して
次に「12345」の1行目を印刷するという形です。
キーになるのは、「文字単位のデータ」になります。
以上説明が難しくて分かりずらいかも知れませんが式を教えてください
よろしくお願いします。
< 使用 Excel:unknown、使用 OS:unknown >
こんにちわ ^^ なぁ〜んとなく。概略は理解できるのですが。 フイルター後、のデーターをコピーしたものを 印刷する部分をエクセルの表形式で←ちょい面倒ですが 詳しくご説明賜ると、お手伝い出来るかもしれません ↑ 多分ですが。。。^^;
http://www.excel.studio-kazu.jp/kw/20110209184943.html
を、拝借すれば、簡単ですよ。 フイルターコピーした表 印刷レイアウトの表 m(__)m (隠居Z) 2021/09/16(木) 12:38
やりたい事は、種類が「別注」で管理番号が同じ明細は一緒に印刷を行う
種類が「除外」は印刷しない様にする
管理番号は同じ文字は最大で5行あり、1行の時も、2行の時も、3行の時も、4行の時もあります。
(A列は無視して下さい、別の事で使う数式が入っているだけです。)
コピーする場所は、B列からF列までになります。
コピーして、別シートに貼付⇒印刷⇒貼付データをクリア⇒元シートに戻り同じことを繰り返す。
を最終行までという形です。
行数は多い時で5000行ぐらいです(印刷する行は100もありません)
|[A]|[B] |[C] |[D] |[E] |[F] [1] | |処理日 |得意先名|商品名|管理番号|種類 [2] | 1|20210915|A社 |商品1|1RG8A |別注 [3] | 0|20210915|B社 |商品2 |1RG9V |別注 [4] | 0|20210915|A社 |商品1 |1RGD9 |除外 [5] | 0|20210915|A社 |商品2 |1RGD9 |除外 [6] | 0|20210915|B社 |商品3 |1RGDL |別注 [7] | 1|20210915|C社 |商品4 |1RGE0 |別注 [8] | 0|20210915|D社 |商品5 |1RGE1 |別注 [9] | 1|20210915|E社 |商品6 |1RGE2 |除外 [10]| 0|20210915|F社 |商品7 |1RGE3 |別注 [11]| 1|20210915|G社 |商品1 |1RGE4 |別注 [12]| 1|20210915|G社 |商品2 |1RGE4 |別注 [13]| 1|20210915|G社 |商品3 |1RGE4 |別注 [14]| 1|20210915|G社 |商品4 |1RGE4 |別注
以上よろしくお願いします。
(JIN) 2021/09/16(木) 13:31
こんにちわぁ ^^ こんなかんじでせうか。←かなりあやしぃA^^; 外していましたら、お許しを。。。m(_ _)m ゴミ箱ポイ、お願いします。 Sheet1がご提示の情報、Sheet2は初期化され、情報が書き込まれます 新規ブックにてお試しを。 でわでわ。m(_ _)m Option Explicit Sub OneInstanceMain() Dim r As Range Dim ws2 As Worksheet Dim zD As Object Dim vAr As Variant Dim t As Double t = Timer Set zD = CreateObject("Scripting.Dictionary") Set ws2 = Worksheets("Sheet2") ws2.UsedRange.Clear With Worksheets("Sheet1") Set r = .Cells(1).CurrentRegion For Each vAr In r.Rows If vAr.Columns(5).Value <> "管理番号" And vAr.Columns(5).Value <> "" Then zD(vAr.Columns(5).Value) = Empty End If Next For Each vAr In zD With ws2 .Range("J1").Resize(, 2) = Array("管理番号", "種類") .Range("J2:K2").NumberFormatLocal = "@" .Range("J2").Resize(, 2) = Array("=" & vAr, "<>除外") r.AdvancedFilter xlFilterCopy, ws2.Range("J1:K2"), ws2.Cells(1), False If .Cells(2, 1) <> "" Then .PrintPreview End If .UsedRange.Clear End With Next End With zD.RemoveAll MsgBox "終了 " & Format(Int(Timer - t) / 24 / 60 / 60, "hh : mm : ss") & _ Format((Timer - t) - Int(Timer - t), ".000") & " 秒" End Sub (隠居Z) 2021/09/16(木) 16:35
おしえてください、
Sheet1の範囲はどこで決めているのでしょうか?
それと、Sheet2のA1からデータを張り付けてますが
そのデータを張り付ける場所を指定するにはどうしたらいいのでしょうか?
自分の加工したエクセルデータは、AB2からBH6までで張り付けてます。
1行目はタイトルです
.Range("J1").Resize(, 2) = Array("管理番号", "種類") .Range("J2:K2").NumberFormatLocal = "@" .Range("J2").Resize(, 2) = Array("=" & vAr, "<>除外") このJ1・K2は、そのABに合わせてBJ1・BK2の様にしても問題ないのでしょうか?
(JIN) 2021/09/17(金) 14:34
こんにちわ ^^ Sheet1の範囲は With Worksheets("Sheet1") Set r = .Cells(1).CurrentRegion です。[A1セルでコントロールと*を押したとき選択される範囲です] Sheet2書き出し位置は r.AdvancedFilter xlFilterCopy, ws2.Range("J1:K2"), ws2.Cells(1), False ~~~~~~~~~~~~ ↑ ここ .Range("J1").Resize(, 2) = Array("管理番号", "種類") .Range("J2:K2").NumberFormatLocal = "@" .Range("J2").Resize(, 2) = Array("=" & vAr, "<>除外") これは、印刷のお邪魔にならないと場所ならどこでも、^^; ず〜と右端の関係無い場所の方が良いですよ。普通は用事が終われば消すのですが ま、消し忘れても、印刷範囲に無ければ関係無いかと。。。^^;。m(_ _)m 消し忘れしてまして済みません。 注意事項 ただ、sheet2は全消去されますので、使用中のシートの一部分にコピペするなら Shheet2を作業シートとし、書き出されたものを再度、ご必要な箇所にこっそり 書込むとかの方が無難ですよ。でわm(_ _)m (隠居Z) 2021/09/17(金) 14:53
張り付けるシートを「一時貼付場所」に変え
データが張り付く場所をBA1BB2に変えたのですが
タイトルしか張り付かなくなってしまったのです…
何がいけないのでしょうか?
Option Explicit
Sub OneInstanceMain()
Dim r As Range Dim ws2 As Worksheet Dim zD As Object Dim vAr As Variant Dim t As Double t = Timer Set zD = CreateObject("Scripting.Dictionary") Set ws2 = Worksheets("一時貼付場所") ws2.UsedRange.Clear With Worksheets("Sheet1") Set r = .Cells(1).CurrentRegion For Each vAr In r.Rows If vAr.Columns(5).Value <> "管理番号" And vAr.Columns(5).Value <> "" Then zD(vAr.Columns(5).Value) = Empty End If Next For Each vAr In zD With ws2 .Range("BA1").Resize(, 2) = Array("管理番号", "種類") .Range("BA2:BB2").NumberFormatLocal = "@" .Range("BA2").Resize(, 2) = Array("=" & vAr, "<>除外") r.AdvancedFilter xlFilterCopy, ws2.Range("BA1:BB2"), ws2.Cells(1), False If .Cells(2, 1) <> "" Then .PrintPreview End If .UsedRange.Clear End With Next End With zD.RemoveAll MsgBox "終了 " & Format(Int(Timer - t) / 24 / 60 / 60, "hh : mm : ss") & _ Format((Timer - t) - Int(Timer - t), ".000") & " 秒" End Sub
(JIN) 2021/09/17(金) 19:10
こんばんわ ^^ 夕方から、回鍋肉を作っていまして。。。今拝見いたしました。 1.Sheet1の情報が、ご提示の内容と違うから。 2.抽出条件を書き込むセルがBA1:BB2になっています 3.抽出先はシート 一時貼付場所 のA1です。 2.3.はそれでよいような気がしますので 多分1.が原因かと。管理番号はシート Sheet1のE列ですか でわ。m(_ _)m (隠居Z) 2021/09/17(金) 20:27
本番で使用するエクセルは、Sheet1に印刷レイアウトのデータを置き
コピーしたデータを別のセルに反映させる
コピーしたデータが全画面クリアになるとの事でしたので
さらに「一時貼付場所」なる別のシートを作成
イコールなどで反映させる事にします。
また、Sheet1の1行目にはマクロのボタンがあります、これはクリアでは消えないですが特に問題はないでしょうか?
本番で使用する印刷レイアウトの表は
Sheet1の
管理番号:S列
種類:AH列になります
データの最終列はAH列になります。
例題では、レイアウト表が物凄いことになってしまうので
Sheet1の
管理番号:E列
種類:F列にしていました
本番の最終列がAH列の為、余裕をもって("BA1:BB2"),にしました。
そこで下記に致しました。
.Range("BA1").Resize(, 2) = Array("管理番号", "種類")
.Range("BA2:BB2").NumberFormatLocal = "@"
.Range("BA2").Resize(, 2) = Array("=" & vAr, "<>除外")
r.AdvancedFilter xlFilterCopy, ws2.Range("BA1:BB2"), ws2.Cells(1), False
どうでしょうか?
純粋に
JやKをBAやBBに書き換えればいいだけかと思っちゃいました(´;ω;`)
すみません、よろしくお願いいたします。
(JIN) 2021/09/18(土) 10:09
おはようございます ^^ なにか、行き違いがある様な気がするのですが Sheet1は大事な元表なので、フイルター処理だけで、削除、変更等は 一切行っておりません。フイルター後の情報と抽出条件をSheet2を初期化 後、書込んでいるだけですが。 (JIN)さん 2021/09/17(金) 19:10 の変更コードでもSheet1が以前のままなら[テストデーター]問題なく動い ておりましたですよ。 最初の方で管理番号の一意なキーを作成してそれを基準にフイルター処理 していますので、そこを、ご修正賜れば、多分、お望みの結果が一時貼付場所 に作成されると思います。 For Each vAr In r.Rows If vAr.Columns(5).Value <> "管理番号" And vAr.Columns(5).Value <> "" Then zD(vAr.Columns(5).Value) = Empty End If Next の全ての vAr.Columns(5).Value を vAr.Columns(19).Value
[E列は左から5ばんめなので5、S列は19番目なので、19です。]
に変えてみて下さい、種類は 除外 で固定です。除外以外は何でも 印刷対象です。←^^;、。。。m(_ _)m (隠居Z) 2021/09/18(土) 10:51
追伸です。。。^^ Sheet1にボタンがあるとの事でしたが 本番情報の項目開始のセル番地はA1では無いのでしょうか もしそうでなければ、さらなる、修正が、必要かも (隠居Z) 2021/09/18(土) 11:10
本番エクセルが会社にある火曜日ないとできないのでそこで試します。
持って帰るの忘れました…
長く付き合ってくださってありがとうございます。
もう少しだけお願い致します。
(JIN) 2021/09/20(月) 09:36
おはようございます ^^ うまく動くといいですね。 火曜日は外出が予定されています。夜には戻っておりますので お許しを。。。^^;。。。何かあれば、他の回答者様がアド バイス下さるかもしれませんね。(#^^#)v m(_ _)m (隠居Z) 2021/09/20(月) 10:42
それは難儀でしたね。 どうぞ、お大事に。。。m(_ _)m (隠居Z) 2021/09/21(火) 17:52
|[A]|[B] |[C] |[D] |[E] |[F] |[G] |[H] |[I] |[J] |[K] |[L] |[M] |[N] |[O] |[P] |[Q] |[R] |[S] |[T] |[U] |[V] |[W] |[X] |[Y] |[Z] |[AA] |[AB] |[AC] |[AD] |[AE] |[AF] |[AG] |[AH] [1]| |処理日 |納期 |得意先|得意先名|宛名|宛名名称|商品CD |商品名 |入枚 |CS数 |荷姿|総数量|売上金額|仕入先名 |仕入先連絡|伝票適用|客先発注番号|管理番号|行番号|SC伝票番号|郵便 |住所 |電話番号 |自動FAX |売上単価|仕入単価|作成日 |作成時間|作成者|作成者名|仕入先|ACOS送信時間|別注品 [2]| 0|20210922|20210924|M2892 |A社 |ZZ |A社 |08390321|ヘアセット | 50| 1|CS | 50| 1800|頭会社 | | | |1RIVU | 1|U0870 |郵便1|住所1|電話番号1|03-0000-0000| 36| 32|20210922| 083422| 19212|樋田 |MEA34 | 084104|除外 [3]| 0|20210922|20210924|M2892 |A社 |ZZ |A社 |08390975|マイスターmini| 50| 1|CS | 50| 1800|頭会社 | | | |1RIVU | 2|U0870 |郵便2|住所2|電話番号2|03-0000-0000| 36| 32|20210922| 083422| 19212|樋田 |MEA34 | 084104|除外 [4]| 0|20210922|20210924|M2892 |A社 |ZZ |A社 |08390568|エキスプレス | 50| 1|CS | 50| 1900|頭会社 | | | |1RIVU | 3|U0870 |郵便3|住所3|電話番号3|03-0000-0000| 38| 34|20210922| 083422| 19212|樋田 |MEA34 | 084104|除外 [5]| 0|20210922|20210928|M4107 |B社 |ZZ |B社 |03988307|名入タオル1 |10000| 4|CS | 40000| 11600|タオル会社| | |8589-153 |1RIVW | 1|U0874 |郵便4|住所4|電話番号4|03-0000-0000| 0.29| 0.24|20210922| 083943| 22007|崇本 |MET28 | 084104|別注 [6]| 1|20210922|20210927|M1653 |C社 |1N |Z店 |03917191|名入タオル5 | 1|10000|枚 | 10000| 5000|日本販売 | | | 4088061701|1RIWM | 1| 48303|郵便5|住所5|電話番号5|03-0000-0000| 0.5| 0.3|20210922| 085552| 41303|吉村 |ME283 | 090105|別注 [7]| 1|20210922|20211001|M1653 |C社 |1N |Z店 |03917191|名入タオル10 |20000| 1|CS | 20000| 10000|日本販売 | | | 4088061801|1RIWQ | 1| 48304|郵便6|住所6|電話番号6|03-0000-0000| 0.5| 0.3|20210922| 085655| 19212|樋田 |ME283 | 090105|別注
下記は本番用に頂いたコードの数字を変えただけのものです。
Option Explicit
Sub OneInstanceMain()
Dim r As Range Dim ws2 As Worksheet Dim zD As Object Dim vAr As Variant Dim t As Double t = Timer Set zD = CreateObject("Scripting.Dictionary") Set ws2 = Worksheets("一時貼付場所") ws2.UsedRange.Clear With Worksheets("Sheet1") Set r = .Cells(1).CurrentRegion For Each vAr In r.Rows If vAr.Columns(19).Value <> "管理番号" And vAr.Columns(19).Value <> "" Then 'Columns(19)が左から何列目の意味S列は19番目 zD(vAr.Columns(19).Value) = Empty End If Next For Each vAr In zD With ws2 .Range("BA1").Resize(, 2) = Array("管理番号", "種類") .Range("BA2:BB2").NumberFormatLocal = "@" .Range("BA2").Resize(, 2) = Array("=" & vAr, "<>除外") r.AdvancedFilter xlFilterCopy, ws2.Range("BA1:BB2"), ws2.Cells(1), False If .Cells(2, 1) <> "" Then .PrintPreview End If .UsedRange.Clear End With Next End With zD.RemoveAll MsgBox "終了 " & Format(Int(Timer - t) / 24 / 60 / 60, "hh : mm : ss") & _ Format((Timer - t) - Int(Timer - t), ".000") & " 秒" End Sub
.Range("BA1").Resize(, 2) = Array("管理番号", "種類")
は邪魔にならない場所にしただけですのでどこでも大丈夫です
コード上でF8で一個一個処理をしてるのですが、タイトル行のみの表示になります…
何度も何度もすみません、時間がありましたらお付き合いくださいませ。
(JIN) 2021/09/22(水) 12:53
こんにちわ〜^^ 腰痛、大丈夫ですか?お大事にして下さいませ。m(_ _)m ちょい、見てみますね、暫時お待ちください。 (隠居Z) 2021/09/22(水) 13:58
お待たせいたしました。^^ 抽出条件の項目名 種類 を AH列の項目名 別注品 に変えてみて下さい。 .Range("BA1").Resize(, 2) = Array("管理番号", "種類") 〜〜〜〜 ↑ ここ m(_ _)m (隠居Z) 2021/09/22(水) 14:28
種類も違う名称にしてましたね(-_-;)
ありがとうございます!
そして、できました!
そして、腰は痛いです…今週は休みが多くて良かった...
本当に長い間ありがとうございました。
また機会があれば宜しくお願い致します。
本当にありがとうございました。
(JIN) 2021/09/22(水) 16:11
[ 一覧(最新更新順) ]
YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki.
Modified by kazu.