質問: 複数シートに色付きセル(条件つき書式で設定済み)の行を別シートに抽出 初めまして。 シート数は30程度。 列数は同じで行数はシートごと(最大30行)に異なります。 複数シートの期限には条件式書式で(期限切れは赤、期限切れ30日前は黄色)セルに色がついています。(期限切れ判断の日はtodayを使用しています) <シート1> a b c d e 1 ○○○株式会社 2 車番 車検期限 保険期限 運転者名 免許期限 3 東京100 2021/1/1 2020/10/10 あいうえ 2020/12/12 4 千葉200 2019/1/1 2019/1/1 かきくけ 2020/8/8 5 ・ ・ ・ ・ ・ 6 ・ ・ ・ ・ ・ . . 30 <シート2> a b c d e 1 △△△株式会社 2 車番 車検期限 保険期限 運転者名 免許期限 3 千葉200 2019/2/1 2019/2/1 さしすせ 2020/9/9 4 千葉200 2021/1/1 2021/1/1 たちつて 2020/8/8 5 ・ ・ ・ ・ ・ 6 ・ ・ ・ ・ ・ . . 30 ↓ <抽出シート> a b c d e 1 ○○○株式会社 2 車番 車検期限 保険期限 運転者名 免許期限 3 千葉200 2019/1/1 2019/1/1 かきくけ 2020/8/8 4 5 △△△株式会社 6 車番 車検期限 保険期限 運転者名 免許期限 7 千葉200 2019/2/1 2019/2/1 さしすせ 2020/9/9 8 9 vbaを使用して セルに色がついているシートの 1行目 会社名 2行目以降の行ごとのデータを別シートに抽出したいと考えています。 よろしくお願いいたします。
回答: こんばんは! 一例です。 標準モジュールにしてください。 sub sample1() dim i as long, j as long, k as long dim ws as worksheet dim myflg1 as boolean, myflg2 as boolean application.screenupdating = false with worksheets("抽出シート") '//▼「抽出シート」のデータを一旦消去// .range("a:e").clearcontents .range("b:c,e:e").numberformatlocal = "yyyy/m/d" '//▼ココから操作// for k = 1 to worksheets.count if worksheets(k).name <> .name then set ws = worksheets(k) for i = 2 to ws.cells(rows.count, "a").end(xlup).row for j = 2 to 5 '//←b~e列まで// if ws.cells(i, j).displayformat.interior.colorindex = 3 or _ ws.cells(i, j).displayformat.interior.colorindex = 6 then myflg2 = true exit for end if next j if myflg2 = true then if myflg1 = false then .cells(rows.count, "a").end(xlup).offset(2).resize(2, 5).value = ws.range("a1").resize(2, 5).value myflg1 = true end if .cells(rows.count, "a").end(xlup).offset(1).resize(, 5).value = ws.cells(i, "a").resize(, 5).value end if myflg2 = false next i end if myflg1 = false next k .range("a1:e2").delete shift:=xlup .columns.autofit .activate end with application.screenupdating = true msgbox "完了" end sub ※ セルの塗りつぶしの色番号が異なると何も反応しません。 カラーインデックスの番号は 赤 → 3 黄 → 6 としています。m(_ _)m