ここから本文です

Excel VBA 一覧表のふたつの列のどちらかに値がある場合だけデータを別のシートへ...

u19********さん

2018/6/1810:55:14

Excel VBA 一覧表のふたつの列のどちらかに値がある場合だけデータを別のシートへ転記して一括印刷するコード


【作業環境】

OS:Windows7 Excel:2013

【現在の状況】

〇スイミングスクールの夏休み短期教室の参加者一覧表を作成しています。
〇夏休み短期教室には、通常のスイミングスクールに在籍している会員の他にも一般の方(非会員)や他のスポーツスクール(体操やテニス等)に在籍している会員も参加します。
〇スイミングスクール在籍会員に関しては、夏休み短期教室のテスト結果を通常スクールの担当コーチへ引き継ぐ必要があるため、テスト結果引継票を作成します。


【実現したいこと】

VBAを使用して参加者一覧表シートのスイミング会員のデータだけをテスト結果引継票シートへ転記して一括印刷したいのです。その際に、
①スイミング会員は参加者一覧表シートの欠席(Y列・データの入力規則でリストを設定)または種目(Z列)のどちらかに値(文字列)を必ず入力するので、ふたつの列のどちらかに値がある行のデータだけを転記して印刷する
②参加者情報一覧表シートのクラス2(M列)に値(数値または文字列)がある場合はテスト結果引継票を2部印刷する
③テスト結果引継票の印刷は、マクロを登録した「引継票発行」という図形(AE1:AG2)をクリックすることで実行し、図形をクリックした時に「印刷にはA4用紙の裏紙を使用して下さい。」というメッセージボックスを表示させる
上記3点を実現するためのコードをご教示下さい。どうか宜しくお願い致します。


【ファイル構成】

1.参加者一覧表シート(参考画像・一覧表の一部を表示)
〇短期水泳教室参加者のデータを入力する一覧表です。
〇一覧表の範囲はA2:AC402までで、最大400名を登録可能にしてあります。
〇参加者がスイミングを含むスポーツスクール会員の場合は、氏名(D列)とフリガナ(E列)は会員番号を入力することでIF関数+VLOOKUP関数を使用して在籍者一覧表シート(後述)から値を転記します。その他の項目は手入力です。参加者が非会員(会員番号列に"N"と入力)の場合は、全ての項目を手入力します。

2.在籍者一覧表シート
〇スイミングを含む各スポーツスクール会員の会員番号・氏名・フリガナの一覧表です。A列:会員番号、B列:氏名、C列:フリガナ です。

3.テスト結果引継票シート
〇スイミング会員のデータを参加者一覧表シートから転記して一括印刷するシートです。
〇印刷範囲は、A1:G30です。
〇参加者一覧表シートから転記するデータ項目と転記するセル位置は、
①会員番号(参加者一覧表シート:C列/テスト結果引継票へ転記するセル位置:D5)②氏名(D列/D6)③級(I列/D7)④クラス1(J列/D13)⑤組1(K列/D14)⑥担当者1(L列/D12)⑦クラス2(M列/F13)⑧組2(N列/F14)⑨担当者2(O列/F12)⑩コース(U/D20)⑪組(V列/D21)⑫担当者(W列/D19)⑬テスト欠席(Y列/D25)⑭種目(Z列/D26)⑮タイム/距離/他(AA列/D27)⑯認定級(AB列/D28)⑰備考(AC列/D29)です。
29)です。

テスト結果引継票,Windows7 Excel,フリガナ,スイミング,参加者一覧表シート,sh2.Range,m&quot

この質問は、活躍中のチエリアン・専門家に回答をリクエストしました。

閲覧数:
190
回答数:
1
お礼:
100枚

違反報告

ベストアンサーに選ばれた回答

プロフィール画像

カテゴリマスター

kky********さん

2018/6/2110:21:14

一例です。
テストの為、プレビューにしてあります。(ここでは2部印刷のチェックは出来ません)
まずこれでテストしてから、Printout部分のコメントを外して下さい。

Sub Sample()
Dim sh1 As Worksheet, sh2 As Worksheet
Dim i As Long
Dim in_add As Variant
Dim out_add As Variant
Dim j As Integer
in_add = Array("C", "D", "I", "L", "J", "K", "O", "M", "N", "U", "V", "W", "Y", "Z", "AA", "AB", "AC")
out_add = Array("D5", "D6", "D7", "D12", "D13", "D14", "F12", "F13", "F14", "D20", "D21", "D22", "D25", "D26", "D27", "D28", "D29")
Application.ScreenUpdating = False
Set sh1 = Worksheets("Sheet1")
Set sh2 = Worksheets("Sheet2")
MsgBox "印刷にはA4用紙の裏紙を使用して下さい。"
With sh1
For i = 3 To Cells(Rows.count, 1).End(xlUp).Row
If .Range("Y" & i) <> "" Or .Range("Z" & i) <> "" Then
sh2.Range("A1:A30").ClearContents
For j = 0 To 16
sh2.Range(out_add(j)).Value = .Range(in_add(j) & i).Value
Next j
sh2.PrintPreview
'If .Range("M" & i).Value = "" Then
'sh2.PrintOut Copies:=1
'Else
'sh2.PrintOut Copies:=2
'End If
End If
Next i
End With
Application.ScreenUpdating = True
End Sub


補足ですが、現在の状況という部分は不要だと思います。(質問の文章が長すぎると回答を得にくくなるのでは)
反対に、印刷レイアウトの説明は項目ごとに改行して箇条書きにした方がいいです。
①会員番号D5(参加者一覧表シート:C列)
②氏名D6(D列)

みんなで作る知恵袋 悩みや疑問、なんでも気軽にきいちゃおう!

Q&Aをキーワードで検索:

Yahoo! JAPANは、回答に記載された内容の信ぴょう性、正確性を保証しておりません。
お客様自身の責任と判断で、ご利用ください。
本文はここまでです このページの先頭へ

「追加する」ボタンを押してください。

閉じる

※知恵コレクションに追加された質問は選択されたID/ニックネームのMy知恵袋で確認できます。

不適切な投稿でないことを報告しました。

閉じる