- 締切済み
条件で印刷シートを別けたい。
データシート"みかん・りんご"に入力データがあり、"C列の'りんご（特定）''りんご（その他）''みかん（特定）''みかん（その他）'を検索。 （特定）がついているのは"D列"産地ごとにシート別に記入し、印刷をしたいのです。 ifを使っても2条件しか識別できないので、困っています。 りんご（長野）、りんご（青森）、りんご（その他）の3種類。 みかん（和歌山）、みかん（愛媛）、みかん（静岡）、みかん（その他）の4種類。 別々のシートに入力し印刷するにはどうしたら良いか教えてください。 コマンドボタンは1つにこだわりはないです。（エクセルの添付画面には、1つしかつけてないですが） 途中まで作成したマクロを載せています。 Range("A2").Select '仕入れ番号をこの次の"A3"セルより転記される。 Do '↓ 'アクティブセルを１つ下に移動 ActiveCell.Offset(1, 0).Select '空欄であれば、プログラムを終了する 'Trim関数は前後のスペースを消去する If Trim(ActiveCell.Value) = "" Then Exit Do End If '非表示セルは印刷の対象としない If ActiveCell.EntireRow.Hidden = False Then If ActiveCell.Offset(, 2).Value = "りんご（その他）" Then 'C列でリンゴかみかんの判断をする With Worksheets("りんご（その他）") 'シートへ記入 .Range("C18").Value = ActiveCell.Offset(0, 0).Value '仕入番号 .Range("C19").Value = ActiveCell.Offset(0, 2).Value '種類 .Range("C20").Value = ActiveCell.Offset(0, 3).Value '産地 .Range("E3").Value = ActiveCell.Offset(0, 4).Value '購入日 .Range("F3").Value = ActiveCell.Offset(0, 5).Value '外観 .Range("G5").Value = ActiveCell.Offset(0, 6).Value '重量 .Range("H5").Value = ActiveCell.Offset(0, 7).Value '単価 .Range("D5").Value = ActiveCell.Offset(0, 9).Value '個数 '繰返し処理をしているので一度に印刷される。 .PrintOut End With ElseIf ActiveCell.Offset(, 2).Value = "りんご（りんご（特定）" Then With Worksheets("りんご（特定）") 'シートへ記入 .Range("C20").Value = ActiveCell.Offset(0, 0).Value '仕入番号 .Range("C21").Value = ActiveCell.Offset(0, 2).Value '種類 .Range("C22").Value = ActiveCell.Offset(0, 3).Value '産地 .Range("E4").Value = ActiveCell.Offset(0, 4).Value '購入日 .Range("F4").Value = ActiveCell.Offset(0, 5).Value '外観 .Range("G7").Value = ActiveCell.Offset(0, 6).Value '重量 .Range("H7").Value = ActiveCell.Offset(0, 7).Value '単価 .Range("D7").Value = ActiveCell.Offset(0, 9).Value '個数 .Range("D8").Value = ActiveCell.Offset(0, 10).Value '送料 '繰返し処理をしているので一度に印刷される。 .PrintOut End With End If End If Loop End Sub
- remonmikan
- お礼率0% (0/1)
- その他MS Office製品
- 回答数1
- ありがとう数0
- みんなの回答 （1）
- 専門家の回答
みんなの回答
- keithin
- ベストアンサー率66% (5278/7940)
関連するQ&A
- 連続印刷処理前に確認しOKしてから再開するマクロ
連続印刷マクロを作成したのですが、印刷の手前で確認を入れたいので、その処理を教えてください。 エクセルの表は項目が14列あり、999行です。 印刷は、2種類のシートに分け印刷できるようになっているのですが、確認は1度だけを考えています。 Sub 印刷_Click() Worksheets("集計・印刷").Activate '作業シート名 Range("A2").Select '番号(001～999)をこの次の"A3"セルより転記される。 Do '↓ ※1度の作業で15個の番号を最大とします。 'アクティブセルを１つ下に移動 ActiveCell.Offset(1, 0).Select '1度の作業で15枚印刷する。 '空欄であれば、プログラムを終了する 'Trim関数は前後のスペースを消去する If Trim(ActiveCell.Value) = "" Then Exit Do End If '非表示セルは印刷の対象としない If ActiveCell.EntireRow.Hidden = False Then If ActiveCell.Offset(, 2).Value = "単品" Then 'C列で単品の判断をする。 With Worksheets("A") 'Aシートへ記入 .Range("C3").Value = ActiveCell.Offset(0, 0).Value '番号 .Range("L24").Value = ActiveCell.Offset(0, 2).Value '種類 .Range("F3").Value = ActiveCell.Offset(0, 3).Value '型式 .Range("C23").Value = ActiveCell.Offset(0, 4).Value '測定日 .Range("C24").Value = ActiveCell.Offset(0, 5).Value '製造日 .Range("C9").Value = ActiveCell.Offset(0, 6).Value 'ライン .Range("C10").Value = ActiveCell.Offset(0, 7).Value '担当 .Range("C7").Value = ActiveCell.Offset(0, 9).Value '外観 .Range("C8").Value = ActiveCell.Offset(0, 10).Value '気密 '繰返し処理をしているので一度に印刷される。 .PrintOut End With ElseIf ActiveCell.Offset(, 2).Value = "複数品" Then'C列で複数品の判断をする。 With Worksheets("B") 'Bシートへ記入 .Range("C3").Value = ActiveCell.Offset(0, 0).Value '番号 .Range("L24").Value = ActiveCell.Offset(0, 2).Value '種類 .Range("F3").Value = ActiveCell.Offset(0, 3).Value '型式 .Range("C23").Value = ActiveCell.Offset(0, 4).Value '測定日 .Range("C24").Value = ActiveCell.Offset(0, 5).Value '製造日 .Range("C9").Value = ActiveCell.Offset(0, 6).Value 'ライン .Range("C10").Value = ActiveCell.Offset(0, 7).Value '担当 .Range("C7").Value = ActiveCell.Offset(0, 9).Value '外観 .Range("C8").Value = ActiveCell.Offset(0, 10).Value '気密 .Range("C11").Value = ActiveCell.Offset(0, 23).Value '(1)min .Range("C12").Value = ActiveCell.Offset(0, 24).Value '(1)max .Range("F7").Value = ActiveCell.Offset(0, 25).Value '(2)min .Range("F8").Value = ActiveCell.Offset(0, 26).Value '(2)max '繰返し処理をしているので一度に印刷される。 .PrintOut End With End If End If Loop End Sub
- ベストアンサー
- その他MS Office製品
- エクセルマクロで条件で印刷がしたいのですが理解不能
エクセルのマクロで条件付きで印刷がしたいのですが、解りません… クイック印刷ボタンを押すとセルの文字列の変化（「合」＆「不」の２種類）によって印刷フォームを変えたいのです。 2列目の結果を判断しA3から空白セルまで連続印刷２種類とも、一度で無理ならボタン2個準備 可 sheet4---"合" フォーム sheet5---"不" フォーム sheet3に一覧表があります。 "合"マクロの作成したのですが、"不"をどのように入れればいいか解りません。 1 2 3 4 5 6 7 8 9 10 ..... 13 14 15 16 A2 製番 合否 種類 型式 開始 終了 工1 工2 外観 気密.....初MIN 初MAX 終MIN 終MAX A3 001 合 AA 123 1/7 1/15 良 良 良 良 0.8 0.9 1.2 1.5 A4 002 合 BB 456 1/8 1/16 良 良 良 良 0.8 0.9 1.2 1.5 A5 003 不 CC 789 1/9 1/12 良 否 良 良 0.6 0.8 - - ・ ・ A22 020 合 TT 999 1/7 1/15 良 良 良 良 0.8 0.9 1.2 1.5 Worksheets("sheet3").Activate Range("A3").Select '開始セル製造番号 'ループXの開始 Do 'アクティブセルを１つ下に移動 ActiveCell.Offset(1, 0).Select If oSht.Cells(idx, 3) = "合" Then ' 繰り返し処理 End If '空欄であれば、プログラムを終了する 'Trim関数は前後のスペースを消去する If Trim(ActiveCell.Value) = "" Then Exit Do End If '非表示セルは印刷の対象としない If ActiveCell.EntireRow.Hidden = False Then 'これ以降、すべて印刷用シート With Worksheets("合") 'レコードの先頭セルを選択 .Range("C3").Value = ActiveCell.Offset(0, 0).Value '製造番号 .Range("L24").Value = ActiveCell.Offset(0, 2).Value '種類 .Range("F3").Value = ActiveCell.Offset(0, 3).Value '型式 .Range("C14").Value = ActiveCell.Offset(0, 4).Value '開始日 .Range("C15").Value = ActiveCell.Offset(0, 5).Value '終了日 .Range("C6").Value = ActiveCell.Offset(0, 6).Value '工程1担当 .Range("C7").Value = ActiveCell.Offset(0, 7).Value '工程2担当 .Range("C9").Value = ActiveCell.Offset(0, 9).Value '外観 .Range("C10").Value = ActiveCell.Offset(0, 10).Value '気密 .Range("C11").Value = ActiveCell.Offset(0, 13).Value '初期MIN .Range("C12").Value = ActiveCell.Offset(0, 14).Value '初期MAX .Range("C13").Value = ActiveCell.Offset(0, 15).Value '終期MIN .Range("C14").Value = ActiveCell.Offset(0, 16).Value '終期MAX 'レコードの最終セルであれば、１部印刷を実行する .PrintOut '印刷用シート終了 End With
- 締切済み
- その他MS Office製品
- 条件別印刷を教えてください。
エクセルマクロで条件別で印刷をしたいのですが？ 合格品、不合格品それぞれのォームで印刷する。 印刷ボタンを押し一覧表からデータ転記後印刷したい。 どうかよろしくお願いします。 印刷ボタンを押すとB列"合格品"表示を選び合格フォームで印刷する。"不合格品"ならば印刷しない。 印刷ボタンを押すとB列"不合格品"表示を選び不合格フォームで印刷する。"合格品"ならば印刷しない。 B列目の結果を判断しA3から空白セルまで連続印刷２種類とも、一度で無理ならボタン2個準備 可 "合格品" フォーム "不合格品" フォーム に一覧表から数値を転記。 sheet3に一覧表があります。 マクロの作成したのですが、うまくいきません。 sheet3 例 列/行 1 2 3 4 5 6 7 8 9 10 ..... 13 14 15 16 A2 製番 合否 種類 型式 開始 終了 A3 001 合 AA 123 1/7 1/15 A4 002 合 BB 456 1/8 1/16 A5 003 不 CC 789 1/9 1/12 ・ ・ A22 020 合 TT 999 1/7 1/15 Worksheets("sheet3").Activate Range("A3").Select '開始セル製造番号 'ループXの開始 Do 'アクティブセルを１つ下に移動 ActiveCell.Offset(1, 0).Select If oSht.Cells(idx, 3) = "合格品" Then ' 繰り返し処理 End If '空欄であれば、プログラムを終了する 'Trim関数は前後のスペースを消去する If Trim(ActiveCell.Value) = "" Then Exit Do End If '非表示セルは印刷の対象としない If ActiveCell.EntireRow.Hidden = False Then 'これ以降、すべて印刷用シート With Worksheets("合格品") 'レコードの先頭セルを選択 .Range("C3").Value = ActiveCell.Offset(0, 0).Value '製造番号 .Range("L24").Value = ActiveCell.Offset(0, 2).Value '種類 .Range("F3").Value = ActiveCell.Offset(0, 3).Value '型式 .Range("C14").Value = ActiveCell.Offset(0, 4).Value '開始日 .Range("C15").Value = ActiveCell.Offset(0, 5).Value '終了日 'レコードの最終セルであれば、１部印刷を実行する .PrintOut '印刷用シート終了 End With
- 締切済み
- その他MS Office製品
- エクセルVBAのIf ～ Thenステートメントで
予約フォームの作成に挑戦しています。 予約日が2022年8月1日の時のみ、シート4に結果を記入して行きたいのですが、 Private Sub CommandButton1_Click() If ListBox1.Text = "44774" Then Sheet4.Select Range("C2").End(xlDown).Offset(1, 0).Select ActiveCell.Value = Reservationform.ListBox2.Value ActiveCell.Offset(0, 1).Value = Reservationform.ListBox3.Value ActiveCell.Offset(0, 2).Value = Reservationform.ListBox4.Value ActiveCell.Offset(0, 2).NumberFormat = Range("C2").NumberFormat Exit Sub End If End Sub で、とりあえず成功しています。 "44774" の部分を、"Sheet6のA2"だった時のみ結果を記入するようにしたいです。 " "の中身をそのまま変えて、 If ListBox1.Text = "sheet6.Range("A2")" Then や If ListBox1.Text = "sheet6.Cells(2, 1).Value" Then に変えてみましたがうまく行きませんでした。 どのようにしたら良いでしょうか？
- ベストアンサー
- Visual Basic
- ExcelVBA・リスト中の1行のみ例外処理したい
VBA初心者です。 エクセル2007で、sheet1にある商品名（A列)・金額(B列)・個数(C列)・発注日(D列)のリスト（AからD列の50行ほどの範囲。行は増える可能性あり）を商品名をキーにあいうえお順で並べ替え、 sheet2のフォーマットの各セル（A6,D6,G9,J9)へsheet1の商品名・金額等を差込→印刷の繰り返しを行うマクロを組みました。 業務内容に変更があり、ある商品（商品名Ｃとします）のみsheet2ではなく、別のフォーマットへ差込印刷しなければならなくなりました。（別のフォーマットはsheet3とします） 商品Cも含めた全リストを、商品名であいうえお順に並べ替えて印刷（商品名順に印刷したい）を行うためにはどのようにマクロを書き換えれば良いか教えていただきたいです。 リスト並べ替え→商品Cの1行前まで差込印刷LOOP→商品Cをsheet3に差込印刷→商品Cの1行 後から差込印刷LOOPという組み立て方でいいのでしょうか？ IF等使用して商品Cの前の行まで繰り返しを指示すればいいのかなと、自分なりに検索して調べてみましたが方法がわかりませんでした。 宜しくお願いします。 Range("A1:D100").sort_ Key1:=Range("A1"),_ Order1:=xlAscending,_ Header.=xlYes,_ Orientation:=xlTopToBottom Workheets("sheet1").Active Range(A1).Select Do Activecell.Offset(1,0).Select If Trim(ActiveCell.Value)=""Then Exit do End if If ActiveCell.EntireRow.Hidden=False Then With Worksheets("sheet2") .Range("A6").value=ActiveCell.Offset(0,0).Value .Range("D6").value=ActiveCell.Offset(0,1).Value .Range("G9").value=ActiveCell.Offset(0,2).Value .Range("J9").value=ActiveCell.Offset(0,3).Value .Printout End With End If Loop End Sub VBAを勉強しだしたばかりですが、今月中に変更する必要があり困っています。 よろしくお願いいたします。
- ベストアンサー
- Visual Basic
- エクセルVBAで無限ループ
教えてください。 以下の２つのエクセルマクロはまったく同じことをさせようとしているのですが、test02の方は.Offset(1).Activateが働かないのか、無限ループに陥ってしまいます。 単にActiveCell.という記述をWith～End Withでまとめただけなのになぜこうなるのでしょうか？ Sub test01() ActiveSheet.Cells(1, 1).Activate Do While ActiveCell.Value <> "" If Not IsNumeric(ActiveCell.Value) Then ActiveCell.Offset(0, 1).Value = "文字" ElseIf ActiveCell.Value > 0 Then ActiveCell.Offset(0, 1).Value = "正数" ElseIf ActiveCell.Value < 0 Then ActiveCell.Offset(0, 1).Value = "負数" Else ActiveCell.Offset(0, 1).Value = "その他" End If ActiveCell.Offset(1).Activate i = i + 1 Application.StatusBar = i Loop End Sub Sub test02() ActiveSheet.Cells(1, 1).Activate With ActiveCell Do While .Value <> "" If Not IsNumeric(.Value) Then .Offset(0, 1).Value = "文字" ElseIf .Value > 0 Then .Offset(0, 1).Value = "正数" ElseIf ActiveCell.Value < 0 Then .Offset(0, 1).Value = "負数" Else .Offset(0, 1).Value = "その他" End If .Offset(1).Activate i = i + 1 Application.StatusBar = i Loop End With End Sub
- ベストアンサー
- オフィス系ソフト
- エクセルマクロ－条件付き繰り返し
マクロ初心者です。（エクセル２００３使用） シート１にある表で、Ｍ列が空白以外（処理済みなどの値がある場合）である場合、その行全体をコピーし、シート２の最終行に貼り付けして、シート１からはその行を削除するマクロを作成したいと思っていますができません。 すみませんが、どなたかご教授願います。 （シート１の表） ・８行目が題目となっており、Ａ９から表となっています。 ・表の全体サイズは、横がＡからＭまでで、縦はＣ(シー）の管理番号行分までとなっています。（Ｍは、空欄があったり値（処理済みなどの値）が入っていたりしています） （考えているマクロ） ・Ｌｏｏｐの回数は、Ｃの管理番号が終わるまで ・ＩＦでＣに値があり、Ｍが空欄だった場合は、そのまま（何もしない） ・Ｃに値があり、Ｍに値があった場合は、その行全体を選択しコピーし、シート３の最終行に貼り付け、シート１のその行は削除する Sub 処理済み() Range("C9").Select Do While ActiveCell.Value = "" ActiveCell.Offset(1).Select Loop If ActiveCell.Offset(, 10).Value = "" Then そのまま Else If ActiveCell.Offset(, 10).Value = "値があったら" Then その行全体を Select.Copy Sheets("Sheet2").Select Dim 下 下 = Range("A").End(xlDown).Row ペースト 削除 End If End Sub すみませんが、どなたか教えていただけましたら助かります。 よろしくお願いいたします。
- ベストアンサー
- Visual Basic
- マクロについて質問です。
A B C 1 3 りんご 2 赤 3 くだもの 4 6 みかん 5 オレンジ 6 くだもの 7 9 ぶどう 8 紫 9 くだもの というデータがシート1にあったとして、シート2のa2セルに6と入力すると以下のようにa5セル以降に抽出し、6という入力を消すと抽出したものも消えるようなマクロ 6 みかん オレンジ くだもの 上のような質問で下のマクロを教えていただけたのですが、もし、みかんのb列も3だった場合いしたのようにみかんの行まで抽出できるようにするには下の構文をどうかえたらよいでしょうか。下手くそな質問ですがよろしくお願いします。 3 りんご 赤 くだもの みかん オレンジ くだもの 現在、わかっている構文↓ Private Sub Worksheet_Change(ByVal Target As Range) 'この行から Dim c As Range, wS As Worksheet Set wS = Worksheets("Sheet1") With Target If .Address = "$A$2" Then If .Value <> "" Then Set c = wS.Range("B:B").Find(what:=.Value, LookIn:=xlValues, lookat:=xlWhole) If Not c Is Nothing Then c.Offset(, 1).Resize(3).Copy Range("A5") Else MsgBox "該当データなし" End If Else Range("A5").Resize(3).ClearContents End If End If End With End Sub 'この行まで
- ベストアンサー
- Excel（エクセル）
- 印刷シートを分けたい
excel2010を使用しています、今勉強中の初心者です、 dataシートに履歴を残すようにしています、dataシート列 Ｌ列に番号１が表示された場合のみSHEET4を印刷し、そうで無い場合SHEET5を刷したいですが、ご教授ください。 Sub rireki() Dim val(1 To 12) Dim lastRow As Long val(1) = Range("AH5").Value val(2) = Range("AJ3").Value val(3) = Range("AJ5").Value val(4) = Range("AK5").Value val(5) = Range("G2").Value val(6) = Range("AI5").Value val(7) = Range("B2").Value val(8) = Range("B5").Value val(9) = Range("E5").Value val(10) = Range("C3").Value val(11) = Range("V2").Value val(12) = Range("V3").Value Application.ScreenUpdating = False With Sheets("data") lastRow = .Cells(.Rows.Count, "C").End(xlUp).Row End With Sheets("data").Range("A" & lastRow).Offset(1).Resize(, 12) = val Sheets("Sheet4").PrintOut Copies:=1, Collate:=True ActiveWorkbook.Save Application.ScreenUpdating = True End Sub
- 締切済み
- Visual Basic
- 印刷後のVBAの実行 (3)
Private Sub Workbook_BeforePrint(Cancel As Boolean) If ActiveSheet.Name = "Sheet1" Then If Range("D6").Value = "" Then Cancel = True MsgBox ("名前を入力してください") Range("D6").Select Exit Sub End If Else If ActiveSheet.Name = "Sheet2" Then If Range("C11").Value = "" Then Cancel = True MsgBox ("受付時間を入力してください") Range("C11").Select Exit Sub End If Else Exit Sub End If End If If Worksheets("Sheet1").Range("D5") = "不要" Then GoTo P1 ActiveSheet.Range("A70:Y70").Copy If Worksheets("Sheet3").Range("A1").Value = "" Then Worksheets("Sheet3").Range("A1").PasteSpecial Paste:=xlPasteValues Else Worksheets("Sheet3").Range("A65536").End(xlUp).Offset(1, 0).PasteSpecial _ Paste:=xlPasteValues End If Application.CutCopyMode = False P1: ActiveSheet.Range("A1").Select End Sub sheet1のD5に「不要」と入っていたら 24～33行目の作業がキャンセルになりますが sheet2のD5にも「不要」と入っていたら、同じ様にキャンセルできる様に出来ますでしょうか？ ご回答お願いします
- 締切済み
- オフィス系ソフト
