[[20061016114205]] 『チェックしたデータのみ別シートに反映させたい2』(つまり) ページの最後に飛ぶ

[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]

 

『チェックしたデータのみ別シートに反映させたい2』(つまり)

 たびたびすみません。
http://ryusendo.no-ip.com/cgi-bin/upload/src/up0521.xls
 現在、受注一覧に入力されたデータを見ながら、
 印刷用の書式に再度入力しています。
 (書式が違うだけで内容は同じです)

 この二度手間を解消する為にどうすればいいのか悩んでいます。

 希望としては・・・
 受注一覧で件名の横に行を入れてチェック(○など)したものを
 印刷用のシートに移動(受注一覧の赤@→印刷用赤@の場所に)させたいのですが、
 一件ずつではなく複数件一気に作業出来ればと思っています。
 (受注一覧に50件入力があったとして、まれに1,2件印刷用に入力しない物件があります)

 計算用のシートは以前にマクロを組む際に結合セルはよろしくないというアドバイスを頂き、
 マクロを組む必要がある時用に作成したものです。

 マクロがいいのか、VLOOKがいいのか???
 何分、知識が足りず最良の方法がわかりません。。。

 ご助言をお願い致します。

 時間が無かったので、後は夜から挑戦。。。
 
 ・チェックは「○」で、1個限定。
 ・計算式での対応用
 ・エラー処理もしていません・・・orz
 
 ※ちゃんと見ましたよって言う意味も含めて計算式用で作ってみました。
 
 気が付いた点
 ・色々なシートで名称が微妙に違う
  (計算式や、マクロでの管理が難しい)
 ・縦や横など、表の使用が統一されていない
  (雛型が制限されているのなら仕方が無いけど、できれば統一した方が管理しやすい?)
 ・どちらかのシートにしか存在しない名称がある
 
 忘れてた・・・
 例のところにアップしてあります。
 (キリキ)(〃⌒o⌒)b

 キリキさん、すばらしいですぅー!
 今、試し打ちしてみたんですが、印刷用にバッチリ行っています!

 >※ちゃんと見ましたよって言う意味も含めて計算式用で作ってみました。
 この意味が分からないんですが・・・教えていただいていいでしょうか?

 >・色々なシートで名称が微妙に違う
 ちゃんと印刷してチェックしたはずが、全然なってませんでした。ごめんなさい・・・

 >・縦や横など、表の使用が統一されていない
 今後の参考に教えてください。
 それは、受注一覧と印刷用の受注内容の並びの事を仰ってるんですよね?
 違ったらすみません・・・

 つまり


 >この意味が分からないんですが・・・教えていただいていいでしょうか?
 いやいや
 ここに何にも記入しないと、つまりさんが不安に思うかもしれないと思い、
 急ごしらえで作ったものをアップしました。
 
 印刷用の表なども変えちゃったので、何かのヒントにでもなれば・・・
 
 >今後の参考に教えてください。
 少し時間を頂いて、考えてみますよb
 
 (キリキ)(〃⌒o⌒)b

 あ、そういう意味ですか〜
 お気遣いありがとうございます!
 今、ジロジロと見て研究しておりますので、
 また変な質問するかと思いますが、
 よろしくお願いします!
 つまり

 とりあえず、作ってみました。
 
 「受注一覧」シートの A列 に、チェック欄を作成。
 Wクリックで「○」を書きます。
 「○」があるとことでのWクリックは、空欄にします。
 印刷したい場所に「○」を作ってください。
 
 次に、マクロの実行で「tumari()」を実行してください。
 多分、大丈夫だと思いますが、、、
 いかんせん、適当に作ってますので、よく検証してみてくださいw
 
 ※検証のためにも、別ファイルで保存してから試した方がいいかもb
 (キリキ)(〃⌒o⌒)b

 キリキさん、ありがとうございますっ!
 すみません!!
 教えていただきたいのですが、、、
 受注一覧に入力をして、A列に○をしたものが印刷シートに飛んで、
 印刷まで出来ちゃうよというマクロですか?
 つまり


 >受注一覧に入力をして、A列に○をしたものが印刷シートに飛んで、
 >印刷まで出来ちゃうよというマクロですか?
 はい。
 って、そういうことではなかったのですか^^;
 また、勝手に妄想して作っちゃったかな?
 
 (キリキ)(〃⌒o⌒)b

 いえいえ、一応コピーした方をいじらせていただいたんですけど、
 計算用がプリンターから出てきたので、
 間違った理解をしてしまったかなと。。。
 受注一覧の列に入力してしまうと、
 =ADDRESS(ROW(),COLUMN(),4)が消えちゃうんですけど、大丈夫なんでしょうか?
  それと、マクロの実行はどのシートでやってもいいんでしょうか?
 (ド素人質問連発ですみません・・・)

 つまり

 >計算用がプリンターから出てきたので
 あぁ〜
 ごめんなさいm(_ _)m
 途中でコード変更して、そこを直してなかったか。。。
 
 PrintOut
 を、
 Sh3.PrintOut
 に変更してください。
 
 >=ADDRESS(ROW(),COLUMN(),4)が消えちゃうんですけど、大丈夫なんでしょうか?
 試し書きですので、いりません。
 思いっきり、データを入力してくださいw
 
 (キリキ)(〃⌒o⌒)b

 ありがとうございまーす!
 思いっきり入力してみまーす!
 すぐ報告させていただきますっ
 つまり

 キリキさーん!
 すごいです!!!!!!!!!!!
 すばらしすぎです!!!
 本当にありがとうございます!
 なにがなんだかさっぱりわかりませんが、
 私も何十年か後にはこんなすごいのを作れるようになりたいので、
 がんばりますっ!
 ありがとうございました
 つまり

 >なにがなんだかさっぱりわかりませんが、
 簡単に説明しますと、
 「計算用」シートに
 「受注一覧」シートに、元となるデータの列番号
 「印刷用」シートに、はめ込む場所のセル番地  を、記入。
 「受注一覧」の「○」が付いている行を上から探し出しはめ込んで印刷。
 
 って感じで行いました。
 コレだったら、シート構成が変わっても、つまりさん本人が変更することが出来そうでしょ?
 
 ただ、、、
 やっぱり、気になるのがシートの結合かな。。。
 最初に提示した、数式用に作ったものがありますよね?
 あちらの、印刷用にはなるべく結合を使わないようにし「計算用」のシートから
 コピー → Shift + 編集 → 図のリンク貼り付け でもって行きました。
 このような方法をとることで、上下の異なる列幅の表を一緒にすることが出来ますよ^^^
 
 何かの参考にでもなればb
 (キリキ)(〃⌒o⌒)b 

 本当にありがとうございます〜
 今、マクロをジロジロと見ております・・・><

 ここできちんと教えて頂かないとまたやっちゃいそうなので、
 教えてください。
 図の貼付はやったことがあるのでわかるんですが、
 表に入力をしなければいけない時は使えないですよね?
 例えば今回の印刷用の様なデータを作成する時、
 まず表の方を基準にセルの幅を決めて作っていくんですか?
 そうすると、上部の方で幅を変えたい時、どうすればいいんでしょうか?

 お時間の余裕のあるときで構いませんので、
 ちょこっと教えていただけるとうれしいです。

 よろしくお願いします。

 つまり

 >まず表の方を基準にセルの幅を決めて作っていくんですか?
 >そうすると、上部の方で幅を変えたい時、どうすればいいんでしょうか?
 色々なセル幅のものを、一つの表にしたいときにσ(^o^;)が良く使う方法は、
 文章も表も全て、図の貼り付けをしてしまいます。
 
 編集用のシートを用意し、横に色々な表などを羅列して作っていきます。
 横に作ることで、セル幅の違いは解決できるでしょ?
 
 それを図形として、真っ白のシートに貼り付けていくのです。
 そうすることで、対応しています。
 (こういった方法が一番いいとは限りません。σ(^o^;)個人の意見です。)
 
 (キリキ)(〃⌒o⌒)b

 そうすると・・・
 入力用のシートは別に作成して飛ぶようにしておくということでしょうか?

 つまり

 そうですね〜
 σ(^o^;)のイメージは、
 
1.入力用シート(データベース)
2.編集用シート(計算式orマクロで作成)
  このシートで、色々な列幅の表を作成
3.印刷用シート(図の貼り付けをしたシート)
 
 こんなイメージでしょうか。
 (キリキ)(〃⌒o⌒)b

 ほぉー
 なるほどぉ〜
 ありがとうございます。
 参考にさせて頂いて、次にいかします!
 つまり

 キリキさん、すみません!
 もうひとつ教えてください!
 マクロ名とコードのSub tumari()って変えられるんでしょうか?
 マクロ名を受注リスト印刷とか分かるように変えたいんですが、
 可能なのか?とやり方を教えていただきたいのですが・・・
 よろしくお願い致します。
 つまり

 びびりつつやってみたら出来ましたw
 つまり

 たびたびすみません・・・
 受注一覧の中のいくつかの列を削除したものを客先に提出しなければならないので、
 受注一覧シートをコピーして新しく提出用シートを作りました。
 提出用シートは受注一覧の内容をイコールで引っ張ってこようと思い、
 やってみたのですが、ブランクのセルにも値が入ってしまいます。
 キリキさん、私はいじっちゃいけない事をやっちまったんでしょうか?
 つまり


 今、お犬様のお散歩中ですW
読んだだけだと、ちょっと意味がわからないかな?
 感じとしては、大丈夫な気がするんですけど…

 (キリキ)(〃⌒o⌒)b

 え・・・お散歩ですかw???
 (余談ですが、明るいうちにお散歩行けてなによりです。私は深夜にお散歩ですw)

 えっとですね、
 例の所を見ていただいていいでしょうか???

 全然急いでませんので!!!
 三回同じようにやってみてダメだったので、助けてください。
 明日でもあさってでもいいですので!!!

 つまり

 4回目にしてやっと気づきました。。
 セルの書式設定は一緒に引っ張ってきてはくれないのですね。。。
 設定したらちゃんと持ってきてくれてました。
 毎度あせって騒いで申し訳ございません・・・
 つまり

 >余談ですが、明るいうちにお散歩行けてなによりです。私は深夜にお散歩ですw
 いや〜
 σ(^o^;)もいつもは夜ですよ^^
 
 今日は、休みだから明るいうちにいけました。
 
 >4回目にしてやっと気づきました。。
 何はともあれ、良かったですね^^
 つまりさんが、頑張ったから解決したんですよb
 これからも頑張ってください〜
 
 (キリキ)(〃⌒o⌒)b

 ありがとうございまーす!
 めげずに頑張っていきますっ♪
 つまり

 キリキさんにご報告です。
 キリキさんにとってはたいしたことないものなんですが、
 作っていただいたデータをいじって(見積内容や備考欄も飛ぶようにしました♪)
 マクロの実行をして全部飛ぶように改造できちゃいました♪
 念の為、確認させていただきたいのですが、
 計算用シートに、受注一覧と印刷用シートのセル番号を入力して、
 マクロのコード
 Tbl = .Range("C2:D95").Value
          ↑この範囲を変更する
 という作業で間違いないでしょうか?

 間違いなければいいんですが、作っていただいたのをちょこっといじっただけなのに、
 今、出来る女気取りで最高に浮かれておりますwww♪

 つまり


 >↑この範囲を変更する
 >という作業で間違いないでしょうか?
 ^^v
 やりましたね〜♪
 
 後は、ヘルプを見ながら流れを確認して、この学校や他で勉強すればドンドン身に付きますよ〜
 ね? 「マクロなんて〜」って牽制しなくても、わかってくると楽しいでしょ?
 
 σ(^o^;)に、できることがあれば言ってくださいな^^
 もちろん、こちらには「達人」に方達が多数いらっしゃいますので、σ(^o^;)がわからなくても
 他の方が、フォローしてくれますのでジャンジャン質問してみましょうb
  
 >今、出来る女気取りで最高に浮かれておりますwww♪
 女性だったんですね^^;
 気が付きませんでしたw
 
 追加:
 今後も範囲が広がる可能性がありそうですので、
 Tbl = .Range("C2:D" & .Range("D" & Rows.Count).End(xlUp).Row).Value
 としておくと、勝手に範囲が変更になってくれます。
 
 (キリキ)(〃⌒o⌒)b


 フェロモン全開で書き込みしたのに、気付いてもらえず残念ですw
 日ごろから女らしく心がけていないとばれちゃうんですねぇ・・・

 コード、ありがとうございます。
 果てしなくなんでも出来ちゃうんですね!
 今後ありうる事なので今から変えておきます!
 わかってくると楽しいとまではまだまだいきませんが、
 大興奮でしたw

 このコードを応用して、印刷用シートを各種用意することも可能ですか???
 えっとですね・・・
 印刷用の書式は6種類あるのですが、
 『こんな時はこの印刷用へ』という条件を元にデータを飛ばすなんて無理でしょうか?

 今回の事では、ホントみなさんに助けていただいて、
 ものすごいのが出来ちゃいました。
 ありがとうございます♪

 つまり


 >印刷用の書式は6種類あるのですが、
 >『こんな時はこの印刷用へ』という条件を元にデータを飛ばすなんて無理でしょうか?
 同じような手法をする方法としては、
 各印刷用のシートを用意する
 例:「印刷1用」「印刷2用」等
 
 計算用シートに、もう1つ列を作る
 例:E列にシート名を追加
	[A]	[B]	[C]	[D]	[E]
[1]			受注一覧	印刷用	シート名
[2]		見積日:	B	BM5	印刷1用
[3]		内定日:	C	BM6	印刷1用
[4]		受注日:	D	BM7	印刷2用
[5]		完結日:	E	BM8	印刷3用
 ※ここで、条件で印刷するシートが変わる場合には、E列に計算式等で分岐する。
 
 コードの変更。
 例:上記のようにした場合
                Tbl = .Range("C2:E" & .Range("E" & Rows.Count).End(xlUp).Row).Value
                For i = 1 To UBound(Tbl, 1)
                    Worksheets(Tbl(i, 3)).Range(Tbl(i, 2)) = Sh1.Range(Tbl(i, 1) & T_R)
                Next i
 
 こんな感じかな?
 (キリキ)(〃⌒o⌒)b

 キリキさん、早速ありがとうございます♪
 出来ちゃうんですねー
 明日チャレンジしてご報告いたしますっ!
 つまり

 度々すみません。
 私も作成依頼になってしまっていて、身につかずおしまいになってしまうとイヤなので教えてください。
 >※ここで、条件で印刷するシートが変わる場合には、E列に計算式等で分岐する。
 …これは〜
 E列にif関数で『こんなときはこっちの印刷シートよ』と入れるという事なんでしょうか?
 となると…計算用シートの受注一覧のセル番号で違いを判別して、
このセルに値があるからこの印刷用シートだ!と導かないとダメなんですよ・・ね?

 『こんな時』が6パターンあるわけなんですが、
 例えば受注一覧のシートでこれは印刷用シート@で、と指示する事も可能でしょうか?

 つまり


 >私も作成依頼になってしまっていて、身につかずおしまいになってしまうとイヤなので教えてください。
 頑張ってくださいb
 σ(^o^;)にわかることであれば、協力しまっせ〜
 
 >E列にif関数で『こんなときはこっちの印刷シートよ』と入れるという事なんでしょうか?
 >となると…計算用シートの受注一覧のセル番号で違いを判別して、
 >このセルに値があるからこの印刷用シートだ!と導かないとダメなんですよ・・ね?
 どういった条件で、6パターンを分けるのでしょうか?
 その規則性がわからないと、数式にしてもどうやったらいいか考えられません。
 まずは整理して、例えでかまいませんので教えてください。
 例:
 ・セル番地「○○」と「△△」と「□□」に入っているときは、パターン1
  同じく、ほにゃららだったら、パターン2
 等など。。。
 
 >例えば受注一覧のシートでこれは印刷用シート@で、と指示する事も可能でしょうか?
 もちろん出来ますよ^^
 そんな場合は、
                Tbl = .Range("C2:D" & .Range("D" & Rows.Count).End(xlUp).Row).Value
                For i = 1 To UBound(Tbl, 1)
                    Worksheets(Sh1.Range("BC" & T_R).Value).Range(Tbl(i, 2)) = Sh1.Range(Tbl(i, 1) & T_R)
                Next i
 のようにするのかな〜?
 実際には、パターン次第でセル番地も変わるでしょうから他にも工夫が必要だと思いますが。
 
 (キリキ)(〃⌒o⌒)b

 おはようございます。
 引き続き教えてください。
 印刷用の書式パターンは全部で5パターンだったのですが・・・

 内訳が

           東 京@
       客先A<その他A

 5パターン<
           東 京B
       客先B<その他C
           異 例D

 ↑のように分かれます。

 客先ABは書式が違います。

 Aの@とAは書式は同じで回覧印が違うだけです。

 Bも同じく@、A、Bと回覧印の違いだけです。

 ここのセルに○○という条件ではなく、
 客先や担当者の部署によって使う書式が変わってしまうので、
 セル番地で印刷パターンへ持って行かせるのは難しそうな感じがします。

 となると・・・受注一覧のシートかなと思うのですが、、、
 教えていただいたコードがどんな事を意味しているのかがわからないのですぅ・・・

 ご教示お願い致しますっ 

 つまり


 携帯から、確認中〜

 PCで、みれる環境はもう少し後なので、待っててねb
 (キリキ)(〃⌒o⌒)b

 PCから見ても、どんな条件でパターンが分かれるかσ(^o^;)にはわかってない・・・
 
 え〜と、、、
 よくわからないけどマクロではなく「計算用」シートに計算式を入れることで出来そうでしょうか?
 例えば、
 =IF(受注一覧シートの条件,印刷パターン1,印刷パターン2)
 などのようにするのはいかがでしょう?
 
 (キリキ)(〃⌒o⌒)b


 説明が下手ですみません〜〜〜

 結局、セルに何が入っているからこの印刷用シートへというより、
 客先がどこだからパターンA、自分が東京だから@の印刷用に。という感じなんです。
 ・・・伝わりますでしょうか?
 受注一覧と印刷用シートの内容が同じですので、
 受注一覧の条件がこうだから@へ違うならAへという訳にもいかない気がするんですが・・・
 回覧印の違いだけなら一枚に統一しようよって感じなんですが、
 そうもいかない事情がございまして・・・

 出来れば、受注一覧のシートで印刷したいものに○をしたように、
 5パターンのいずれかにチェックを入れたら,
 該当の印刷用シートに!みたいになるといいなと思うんですが・・・・

 午前中、教えていただいたマクロのコードの解読を必死になってやりました。
 コードって難しいですねぇ・・・・
 頭がガンガンいたします。。。

 つまり


 >・・・伝わりますでしょうか?
 ごめんなさい。。。
 σ(^o^;)が理解力無くて・・・
 
 >出来れば、受注一覧のシートで印刷したいものに○をしたように、
 >5パターンのいずれかにチェックを入れたら,
 >該当の印刷用シートに!みたいになるといいなと思うんですが・・・・
 であれば、
 ライブラリの【簡易リストボックス Win】
http://www.excel.studio-kazu.jp/lib/e2k/e2k.html
 
 こちらを利用して、分岐してあげるのはいかが?
 (キリキ)(〃⌒o⌒)b

 ありがとうございます。
 リストボックスで印刷用シートを選べるようにして、
 昨夜教えていただいたコード修正・追加すればいいという事なんでしょうか?
 リストボックスは作ったことがあるので出来るのですが、、、
 コードがどこをどういじったらいいのかもわかりません・・・
 B列にリストボックスを作成するとしたら、
 コードのどこをどのようにしたらいいのでしょうか?

 Tbl = .Range("C2:D" & .Range("D" & Rows.Count).End(xlUp).Row).Value
                 For i = 1 To UBound(Tbl, 1)
                     Worksheets(Sh1.Range("BC" & T_R).Value).Range(Tbl(i, 2)) = Sh1.Range(Tbl(i, 1) & T_R)
                Next i

 つまり


 >B列にリストボックスを作成するとしたら、
 Worksheets(Sh1.Range("BC" & T_R).Value).Range(Tbl(i, 2)) = Sh1.Range(Tbl(i, 1) & T_R)
 を、
 Worksheets(Sh1.Range("B" & T_R).Value).Range(Tbl(i, 2)) = Sh1.Range(Tbl(i, 1) & T_R)
 かな?
 
 (キリキ)(〃⌒o⌒)b

 何度もしつこくてすみません。
 今、やってみました。

 まず受注一覧B列に印刷用シート指定列を作成。
 計算用シートの受注一覧のセル番号を修正。
 マクロは↓このように修正しました。

 Sub 決裁書印刷実行マクロ()
 Dim Tbl As Variant, Chk As Variant
 Dim Sh1 As Worksheet, Sh2 As Worksheet, Sh3 As Worksheet
 Dim T_R As Long, i As Long
     If Application.CountIf(Worksheets("受注一覧").Range("A:A"), "○") = 0   Then: _
         MsgBox "チェックがありません!": Exit Sub
     Set Sh1 = Worksheets("受注一覧")
     Set Sh2 = Worksheets("計算用")
     Set Sh3 = Worksheets("印刷用")
     With Sh2
         For Each Chk In Sh1.Range("A4", Sh1.Range("A" & Rows.Count).End(xlUp))
             If Chk = "○" Then
                 T_R = Chk.Row
                 Tbl = .Range("C2:D95").Value
                 For i = 1 To UBound(Tbl, 1)
                     Worksheets(Sh1.Range("B" & T_R).Value).Range(Tbl(i, 2)) = Sh1.Range(Tbl(i, 1) & T_R)

                 Next i
                 Sh3.PrintOut

             End If
         Next Chk
         For i = 1 To UBound(Tbl, 1)
             Sh3.Range(Tbl(i, 2)) = ""
         Next i
     End With
     Set Sh1 = Nothing
     Set Sh2 = Nothing
     Set Sh3 = Nothing
     Erase Tbl
 End Sub

 すると、↓この部分でエラーになってしまいます。

 Worksheets(Sh1.Range("B" & T_R).Value).Range(Tbl(i, 2)) = Sh1.Range(Tbl(i, 1) & T_R)

  また↓この部分の修正は必要ですよ・・・ね?
 Sh3.PrintOut

 教えてください。お願いします。

 つまり

 すみません、間違えました!
 ↓このコードを
Tbl = .Range("C2:D" & .Range("D" & Rows.Count).End(xlUp).Row).Value
                For i = 1 To UBound(Tbl, 1)
                    Worksheets(Sh1.Range("BC" & T_R).Value).Range(Tbl(i, 2)) = Sh1.Range(Tbl(i, 1) & T_R)
                Next i

 ↓一部このように変えて
Worksheets(Sh1.Range("B" & T_R).Value).Range(Tbl(i, 2)) = Sh1.Range(Tbl(i, 1) & T_R)

 やらないといけなかったんですよね。。。
 しくじりました・・・

 つまり

 改めてやってみましたが、
 やはり、↓ここで黄色くなってしまいます・・・
 Worksheets(Sh1.Range("B" & T_R).Value).Range(Tbl(i, 2)) = Sh1.Range(Tbl(i, 1) & T_R)

 Sub 決裁書印刷実行マクロ()
Dim Tbl As Variant, Chk As Variant
Dim Sh1 As Worksheet, Sh2 As Worksheet, Sh3 As Worksheet
Dim T_R As Long, i As Long
    If Application.CountIf(Worksheets("受注一覧").Range("A:A"), "○") = 0 Then: _
        MsgBox "チェックがありません!": Exit Sub
    Set Sh1 = Worksheets("受注一覧")
    Set Sh2 = Worksheets("計算用")
    Set Sh3 = Worksheets("印刷用")
    With Sh2
        For Each Chk In Sh1.Range("A4", Sh1.Range("A" & Rows.Count).End(xlUp))
            If Chk = "○" Then
                T_R = Chk.Row
                Tbl = .Range("C2:D" & .Range("D" & Rows.Count).End(xlUp).Row).Value
                For i = 1 To UBound(Tbl, 1)
                    Worksheets(Sh1.Range("B" & T_R).Value).Range(Tbl(i, 2)) = Sh1.Range(Tbl(i, 1) & T_R)
                Next i

                Sh3.PrintOut

            End If
        Next Chk
        For i = 1 To UBound(Tbl, 1)
            Sh3.Range(Tbl(i, 2)) = ""
        Next i
    End With
    Set Sh1 = Nothing
    Set Sh2 = Nothing
    Set Sh3 = Nothing
    Erase Tbl
End Sub

 プリントアウトの部分の修正でしょうか?

 つまり


 遅くなりました^^;
 
 >プリントアウトの部分の修正でしょうか?
 そうですね。
 プリントアウトの部分も変更してあげないといけませんね。
 
 こんな感じでしょうか?
Sub tumari()
'変数の宣言
Dim Tbl As Variant, Chk As Variant
Dim Sh As String
Dim Sh1 As Worksheet, Sh2 As Worksheet
Dim T_R As Long, i As Long
    '「受注一覧」シートのA列に、「○」がなければ、メッセージを出し終了
    If Application.CountIf(Worksheets("受注一覧").Range("A:A"), "○") = 0 Then: _
        MsgBox "チェックがありません!": Exit Sub
    '各Sh1・Sh2 に、シート名「受注一覧」「計算用」をセット
    Set Sh1 = Worksheets("受注一覧")
    Set Sh2 = Worksheets("計算用")
    'Sh2 内での一連の作業開始
    With Sh2
        'Chk に、Sh1 の A列 の最終列までを一つずつ格納し、繰り返し
        For Each Chk In Sh1.Range("A4", Sh1.Range("A" & Rows.Count).End(xlUp))
            'もし、格納した Chk が「○」だったら次へ
            If Chk = "○" Then
                'T_R に、Chkが入っていた行番号を格納
                T_R = Chk.Row
                'Tbl に、Sh2 の C2:D の最終行までを格納
                Tbl = .Range("C2:D" & .Range("D" & Rows.Count).End(xlUp).Row).Value
                'Sh に、Sh1 の B列の T_R 行に入っているシート名を格納
                Sh = Sh1.Range("B" & T_R).Value
                '1〜Tbl に入れたデータの最大行数分繰り返し
                For i = 1 To UBound(Tbl, 1)
                    'シート Sh の Tblに入れた上から i番目の左から 2番目のセル番地に
                    'Sh1 の Tblに入れた上から i番目の左から 1番目の、列の T_R 行を挿入
                    Worksheets(Sh).Range(Tbl(i, 2)) = Sh1.Range(Tbl(i, 1) & T_R)
                'i回繰り返し
                Next i
                'シート Sh を、プリントアウト
                Worksheets(Sh).PrintOut
                'メッセージボックスで、どのシートをプリント中か出す。
                '※いらなければ消してください
                MsgBox "「" & Sh & "」 を、プリント中"
                'もう一度、i回分繰り返し
                For i = 1 To UBound(Tbl, 1)
                    '上で挿入した場所を「""」(空欄)にする
                    Worksheets(Sh).Range(Tbl(i, 2)) = ""
                'i回繰り返し
                Next i
            'もしの終了
            End If
        'Chk回分繰り返し
        Next Chk
    'Sh2 の一連の作業終了
    End With
    'セットしたものを解放
    Set Sh1 = Nothing
    Set Sh2 = Nothing
    Erase Tbl
End Sub
 
 「受注一覧」のB列に印刷するシート名を、リストで作成し
 「計算式」シートのセルは変更してあるのですよね?
 シート名があっているかも確認してみてください。
 ※いらなくなった変数も消しました。
 
 (キリキ)(〃⌒o⌒)b

 キリキさん、ありがとうございます。
 ’ではじまる部分は解説して頂いたんでしょうか???
 やってみたんですが、重大なミス発覚です・・・
 またまたやってしまいました。
 5枚(2種類)ある印刷用シートなんですが、
 セル番号がダブってるんです。
 例えば客先Aの受注日のセル番号はBM7なのに対し、
 客先BのBM7は完結日なんです。
 ここは統一というかどちらかにしないとダメですよね。。。
 ABで項目が若干違う為何箇所かこういったセルが出てきてしまってます。

 [ 計算用シート ]

        受注一覧  印刷用
 見積日:    C     BM5
 内定日:    D     BM6
 受注日:    E     BM7
 完結日:    F     BM8 

 ↑こうなっていたんですが、セル番号の確認をしたところ

       受注一覧   印刷用(A)     印刷用(B)
 見積日:    C     BM5          BM5
 内定日:    D     BM6          Bシートでは内定日の設定なし
 受注日:    E     BM7          BM6
 完結日:    F     BM8          BM7

 印刷用シートの構成を見直して再チャレンジですよね・・・
 コードを活かせるようにシートの修正をしたいと思います。
 出来次第、またご報告いたしますので・・・
 ありがとうございました!

 つまり
    

 今日は時間ができるかどうかわからないので、今のうちに。。。
 
 もし、パターンでセル番地が違うのなら、
 「計算用」シートに、IF関数等で分岐しては如何でしょう?
 例:
 =IF(受注一覧シートのB列の印刷パターン=印刷パターン1,印刷パターン1のセル番地,印刷パターン1ではないセル番地)
 の様に。
 
 >’ではじまる部分は解説して頂いたんでしょうか???
 はい。
 一応コードの説明を書いておきました。
 
 >Bシートでは内定日の設定なし
 との事なので、コードも下記に変更
 
                For i = 1 To UBound(Tbl, 1)
                    'Tbl i番目の左から 2番目が空欄以外で下の処理
                    If Tbl(i, 2) <> "" Then
                        'シート Sh の Tblに入れた上から i番目の左から 2番目のセル番地に
                        'Sh1 の Tblに入れた上から i番目の左から 1番目の、列の T_R 行を挿入
                        Worksheets(Sh).Range(Tbl(i, 2)) = Sh1.Range(Tbl(i, 1) & T_R)
                    'もし終了
                    End If
                'i回繰り返し
                Next i
 
 (キリキ)(〃⌒o⌒)b

 キリキさん、お忙しいところこんなに早くお返事頂いて恐縮ですぅ
 アドバイスいただいたようにやってみたいと思います!

 やっぱり解説いただいたんですねw
 ご丁寧にありがとうございます。
 コードの解読がしたくてネットや本を読んでいたところなので、
 とても助かりました!

 つまり

コメント返信:

[ 一覧(最新更新順) ]


YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki. Modified by kazu.