こんにちはゲストさん。会員登録(無料)して質問・回答してみよう!

解決済みの質問

エクセル 複数シートを連動させる

EXCELで下記のリンク(画像が添付できなかったのでお手数おかけします)画像のような文化祭の準備の物品貸し出し表を作成しているのですが、知識がないため行き詰まってしまっていて、作成期限が迫っているので皆様のお力をお借りできたらと考えております。
今回は見やすいように2つのブックを使用していますが、左がシート1で右がシート2だと考えてください。
まず現時点で完成している機能としては、
・VBAによるユーザーフォームでシート1の情報を簡易入力
・返却期限を一週間後に設定し、その期限が来たら視覚的に色を付け、期限切れの欄に自動で「◎」がつくように設定
※今は日付上色がついていませんが、実際は期限の前日、当日、翌日からの7日間 の間は返却期限のセルがそれぞれ色付けされるように書式設定してあります。
・期限内に返却された場合は、返却済み欄に ◯ を入力することによって期限切れ欄にはマークされないように設定
大まかにはこのような感じなのですが、ここからが本題です。
「期限切れになったところを抽出してわかりやすくしておいてくれ。」
という指示があり、期限切れになるとシート2に上から順に「NO.」から「担当者名」までが抽出されるようにしたいです。
そして、抽出されたデータがある行はセルが色付けされるようにしたいです。
また、シート2の一番右「返却確認」に◯がついた場合、シート2のその行の色付けを解除し、シート1の対応している行の期限後返却確認 の欄に◯がつくようにしたいです。
VBAが必要でしたら使用しても構いません。
自分の知識に見合わないような複雑な作業をすることになってしまい、説明もごちゃごちゃしてしまい申し訳ないのですが、教えていただければ嬉しく思います。
画像リンク;https://gyazo.com/0f79b7c20f5c7a0d7b7069c61b202517

投稿日時 - 2019-08-09 02:35:14

QNo.9643947

すぐに回答ほしいです

質問者が選んだベストアンサー

こんなものかなということで作ってみました。
画像リンクを参考に作っています。マクロ内に絶対番地がかなり入っています。
分かりやすく書いたつもりなのでなんとかなればと思います。最大行数は「2000行」にしています。

色指定の「xlThemeColorAccent6」などはネットで調べたり、マクロを記録して好きな色に変更してください。

質問を読んでそのまま作ると、Sheet1の「期限後返却確認」に印をつけても、再度抽出すると期限切れとして抽出されます。
期限切れも消したい場合は、「 '.Offset(rw1, 9) = "" '// 期限切れをクリア」のコメントを外してください。

Sheet1からの抽出はボタンから指示できますが、「返却確認」に対応した処理はセルの変更を契機に動くようにしています。

Excel2010で確認しました。
<Sheet1>にCommandButtonを1つ作り、
<Sheet1>のコードウィンドウに以下を貼り付けます

Private Sub CommandButton1_Click()
  Dim rw1 As Long '// 行番号(Sheet1)
  Dim rw2 As Long '// 行番号(Sheet2)
  Dim col As Long '// 列番号
  Dim ws2 As Worksheet '// sheet2
  Set ws2 = Worksheets("Sheet2")

  With Worksheets("Sheet2").Range("B4:J2000")
    .ClearContents '// テキトーに消す
    .Interior.Pattern = xlNone
  End With

  rw1 = 0: rw2 = 0
  With Range("B4")
    '// 全件調べる
    While .Offset(rw1, 0) <> ""
      If .Offset(rw1, 9) <> "" Then '// 期限切れに入力があれば
        For col = 0 To 7 '// Sheet2にコピーする
          ws2.Range("B4").Offset(rw2, col) = .Offset(rw1, col)
        Next

        With ws2.Range("B4") '// 色を付ける(好きな色にしてください)
          ws2.Range(.Offset(rw2, 0), .Offset(rw2, 7)).Interior.ThemeColor = xlThemeColorAccent6 '// 色指定
        End With

        rw2 = rw2 + 1
      End If
      rw1 = rw1 + 1
    Wend
  End With
End Sub

<Sheet2>のコードウィンドウに以下を貼り付けます
'// 返却確認に「○」が入力された時の処理
Private Sub Worksheet_Change(ByVal Target As Range)
  Dim num As Integer '// No.
  Dim rw1 As Long '// 行番号(Sheet1)

  '// 1つのセルへの入力で、J列への入力でデータがあれば処理をする
  If Target.Count = 1 Then
    If Not (Application.Intersect(Range("J4:J2000"), Target) Is Nothing) Then
      With Target
        If .Offset(0, -8) <> "" And Target = "○" Then
          Range(.Offset(0, -8), .Offset(0, -1)).Interior.Pattern = xlNone
          '// 期限後返却確認
          num = .Offset(0, -8)
          With Worksheets("Sheet1").Range("B4")
            While .Offset(rw1, 0) <> ""
              If .Offset(rw1, 0) = num Then
                .Offset(rw1, 10) = "○" '// 期限後返却確認に○
                '.Offset(rw1, 9) = "" '// 期限切れをクリア 今はコメント行
              End If
              rw1 = rw1 + 1
            Wend
          End With
        End If
      End With
    End If
  End If
End Sub

投稿日時 - 2019-08-09 06:52:03

お礼

回答ありがとうございます!
参考にさせていただきます

投稿日時 - 2019-08-10 16:17:12

ANo.2

このQ&Aは役に立ちましたか?

0人が「このQ&Aが役に立った」と投票しています

回答(6)

ANo.6

質問に余分な、回答に関係ない、個人的事情などを書かないこと。
データ例を少数挙げること。
ーー
条件で行データを抜き出す1つの方法を解説する。
自称imogasi方式を、下記でやってみる。
作業列をSheet1のG列を使うが、(1)VBAや(2)INDEX-Match]-SMALL方式(3)数式配列を誓う方法より、理解しやすいだろうと思う。
例データ Sheet1 シートのデータのコピペだが、何とかわかるだろう。
貸出日品名 数 借主 返却日
2019/7/12マット2田中2019/7/13
2019/7/13ベース4木村
2019/7/14ボール20田中淳2018/7/14
2019/7/15ミット3大野
2019/7/16グラブ5小田
2019/7/16ラインマーカ1鈴木
2019/7/13ジョロ4戸田
G1見出し=「該当件」と文字入力。多少違っても何でもよい。
G2の式 =IF(E2<>"","",IF(A2+7<=$F$1,MAX($G$1:G1)+1,""))
($の付けてある位置と、$の有無は正確に)
式の意味は、現在日と貸し出し日+7の大小を比較判定しただけ。該当件数に上行から連番を振っているだけ。
エクセルでは、日付は、日々の順の、整数的な数であることを知ること。
+7は返却日条件を7日後と(小生が)単純化にしたところから来る。
G列でG3せるから、データのある最下行まで式複写。
===
Sheet2に行って
第1行に見出し作成 =TEXT(Sheet1!F1,"yy/mm/dd") &"現在 未返却物"
Sheet1のF1セルに現在日入力してあるとする。2019/7/22 する
第2行に見出し 貸出日品名数借主返却日 コピペ
Sheet2のA3セルに=INDEX(Sheet1!$A$1:$E$100,MATCH(ROW()-2,Sheet1!$G$1:$G$100,0),COLUMN())を入れる。
右方向にE列まで式を複写。
A3:E3を範囲指定して、E3での+ハンドルを下方向に引っ張る。
未返却の該当が3件なので、第5行目で複写を止める。
結果 Sheet2 A1:E5
19/07/22現在 未返却物
貸出日品名数借主返却日
2019/7/13ベース4木村0
2019/7/15ミット3大野0
2019/7/13ジョロ4戸田0

投稿日時 - 2019-08-10 16:00:44

補足

個人情報は気をつけるようにします
ありがとうございます

投稿日時 - 2019-08-10 16:20:11

お礼

回答ありがとうございます!
教えて頂いた通りやってみます!

投稿日時 - 2019-08-10 16:19:51

ANo.5

>期限切れになるとシート2に上から順に「NO.」から「担当者名」までが抽出されるようにしたいです。
1つのブックにSheet1とSheet2を作成し、Sheet1を「物品貸出簿」とします。
Sheet2は期限切れの貸し出し明細を組み込み関数で抽出します。
Sheet2のB4セルに次の数式を設定し、右と下へコピーします。
=IF(COUNTIFS(Sheet1!$H$4:$H$20,"<"&TODAY(),Sheet1!$J$4:$J$20,"<>"&"◯")<ROWS(B$4:B4),"",INDEX(Sheet1!$A$1:$I$20,SMALL(INDEX((Sheet1!$H$4:$H$20<TODAY())*(Sheet1!$J$4:$J$20="")*ROW($B$4:$B$20)+(Sheet1!$J$4:$J$20="◯")*21+(Sheet1!$H$4:$H$20>=TODAY())*21,0),ROWS(B$4:B4)),COLUMN()))
計算範囲の4行から20行は「物品貸出簿」の行数に応じて変更してください。
Sheet2のC列とH列は日付のシリアル値が返されますので表示形式を「m月d日」に設定します。
Sheet2のJ列へキーボードから入力された値をSheet1のL列へ反映させるにはL4セルへ次の数式を設定して下へ必要数コピーします。
=IFERROR(VLOOKUP(B4,Sheet2!$B$4:$J$20,9,FALSE)&"","")
Sheet1のL列へ反映されたマークをSheet2の抽出に反映して消し込みをすることは数式の参照がループになるため関数では対応できません。
Sheet2のJ列に「◯」を入力した結果でセルの塗りつぶしを解除するには条件付き書式で対応すれば良いでしょう。

添付画像はExcel 2013で検証した結果です。

投稿日時 - 2019-08-09 22:08:12

お礼

回答ありがとうございます
教えて頂いた通りやってみます

投稿日時 - 2019-08-10 16:19:13

ANo.4

>今回は見やすいように2つのブックを使用していますが、左がシート1で右がシート2だと考えてください。
2つのブックですか?
1つのブックに2枚以上のSheetを作成できますので1つのブックで良いと思います。

>期限切れになるとシート2に上から順に「NO.」から「担当者名」までが抽出されるようにしたいです。
Excelの組み込み関数だけでも処理可能です。
期限切れのみを抽出する理由は何ですか?
未返却の全てを抽出するのであれば返却時のチェックリストとして利用できますが未返却で期限切れのみを抽出しても無駄になりませんか?
当方ではExcel 2013で提示の画像内容で目的に合う数式を検証してみます。
結果は後日回答します。

>VBAが必要でしたら使用しても構いません。
他の回答への補足ではVBAの知識も無いようですから仕様変更が発生したときまた此処へ質問しなければなりません。
論理も分からずに丸写しで流用するのは如何なものでしょう。

投稿日時 - 2019-08-09 15:57:23

お礼

回答ありがとうございます
確かに仕様変更された場合は対処しきれなくなってしまいますね…
参考にさせていただきます

投稿日時 - 2019-08-10 16:18:26

ANo.3

画像リンクに何も表示されません。
サンプルデータをテキストデータ(空白またはカンマ区切り)で提示してください。

投稿日時 - 2019-08-09 07:01:03

ANo.1

>>VBAによるユーザーフォームでシート1の情報を簡易入力
ここまで作るスキルがあるなら、同様にVBAで期限切れを抽出するといいと思います。
『期限切れの欄に自動で「◎」がつく』という部分を利用して、K列を目印に対象行を抽出。シート2に内容をコピーさせればいいでしょう。
ただこの方式だと、返却された後にシート2からも削除しなければならないので、いっそシート2は開くたびに抽出・表示させるだけと割り切ったほうが手間がないと思います。

ただわざわざシートを分ける必要があるのか? については再度確認した方がいいですね。同一シートでいいなら、期限切れ欄でフィルタさせるだけで済むので圧倒的にシンプルです。

投稿日時 - 2019-08-09 06:43:01

補足

実はこちらのVBAのコードも、質問させて頂いて書いたコードなので、ほんとに知識がないんです…
ただ、高校の生徒会の中では1番Excelが出来てしまうので頼まれてしまったという感じなんです…( ̄▽ ̄;)
ただ確かにおっしゃる通り、同一シートでフィルタすればいいだけの話ですね…!
単純にその発想出てきませんでした(笑)
それも方法の一つとして検討します!
僕以外にもそこまでパソコンが得意じゃない人もいるので、それが一番楽かもしれませんね

投稿日時 - 2019-08-09 09:58:43

あなたにオススメの質問