VBA100本ノック 49本目：条件付き書式の判定
条件付き書式の書式が適用されている行だけをコピーし、条件付き書式の書式をセルの書式に設定する問題です。
ツイートでの見やすさを考慮して、ブック・シート指定等を適宜省略しています。
マクロVBAを初心者向けの基本から上級者向けの高度な内容までサンプルコードを掲載し解説しています。エクセル関数・機能・基本操作の入門解説からマクロVBAまでエクセル全般を網羅しています。
出題
出題ツイートへのリンク
#VBA100本ノック 49本目
D列には以下の条件付き書式が設定されています。
・文字色(赤)
・塗りつぶし(赤,黄)
条件が適用されている行を別シートに値を転記し、同じ文字色と塗りつぶしをセルの書式に設定してください。
※元セルは書式設定されていません。
※転記元と転記先シートは任意
補足します。
条件付き書式の結果「赤文字・赤黄塗りつぶし」となっている行を別シートに値を転記します。
そして、転記先のセルに条件付き書式の結果の「赤文字・赤黄塗りつぶし」を通常のセルの書式として設定するという事です。
さらに補足します。
出力順は、特に明記していないので任意とします。
つまり、転記先は元の順番と違っても構いません。
気になるようでしたら、A列で並べ替えれば良いです。
サンプルファイルです。
https://excel-ubara.com/vba100sample/VBA100_49.xlsm
https://excel-ubara.com/vba100sample/VBA100_49.zip
D列には以下の条件付き書式が設定されています。
・文字色(赤)
・塗りつぶし(赤,黄)
条件が適用されている行を別シートに値を転記し、同じ文字色と塗りつぶしをセルの書式に設定してください。
※元セルは書式設定されていません。
※転記元と転記先シートは任意
条件付き書式の結果「赤文字・赤黄塗りつぶし」となっている行を別シートに値を転記します。
そして、転記先のセルに条件付き書式の結果の「赤文字・赤黄塗りつぶし」を通常のセルの書式として設定するという事です。
出力順は、特に明記していないので任意とします。
つまり、転記先は元の順番と違っても構いません。
気になるようでしたら、A列で並べ替えれば良いです。
https://excel-ubara.com/vba100sample/VBA100_49.xlsm
https://excel-ubara.com/vba100sample/VBA100_49.zip
VBA作成タイム
この下に頂いた回答へのリンクと解説を掲載しています。
途中まででも良いので、できるだけ自分でVBAを書いてみましょう。
他の人の回答および解説を見て、書いたVBAを見直してみましょう。
頂いた回答
解説
条件付き書式の条件に合致した後の書式を取得するには、
RangeオブジェクトのDisplayFormatで取得できます。
DisplayFormatのFontとInteriorを判定しながら順次出力シートに転記し、
その書式を出力シートに設定していきます。
エクセルのフィルターには色フィルターがあります。
「セルの色でフィルター」「文字の色でフィルター」これらで絞り込むことができます。
このVBAは記事補足に掲載しました。
RangeオブジェクトのDisplayFormatで取得できます。
DisplayFormatのFontとInteriorを判定しながら順次出力シートに転記し、
その書式を出力シートに設定していきます。
Sub VBA100_49_01()
Dim wsIn As Worksheet: Set wsIn = Worksheets("49In")
Dim wsOut As Worksheet: Set wsOut = Worksheets("49Out")
Dim rng As Range
Set rng = wsIn.Range("A1").CurrentRegion
wsOut.Range("A1").CurrentRegion.Offset(1).Clear
Dim i As Long, rOut As Long
rOut = 2
For i = 2 To rng.Rows.Count
With rng.Cells(i, 4).DisplayFormat
If .Font.Color = vbRed Or _
.Interior.Color = vbRed Or _
.Interior.Color = vbYellow Then
wsOut.Cells(rOut, 1).Resize(, rng.Columns.Count) = rng.Rows(i).Value
If .Font.Color = vbRed Then
wsOut.Cells(rOut, 4).Font.Color = .Font.Color
Else
wsOut.Cells(rOut, 4).Interior.Color = .Interior.Color
End If
rOut = rOut + 1
End If
End With
Next
End Sub
「セルの色でフィルター」「文字の色でフィルター」これらで絞り込むことができます。
このVBAは記事補足に掲載しました。
補足
色フィルターには「セルの色でフィルター」と「文字の色でフィルター」があります。
この機能を使ったVBAが以下になります。
・文字色(赤)
・塗りつぶし(赤)
・塗りつぶし(黄)
これらで順次フィルターしてからコピーしています。
・文字色(赤)
・塗りつぶし(赤)
・塗りつぶし(黄)
これらで順次フィルターしてからコピーしています。
Sub VBA100_49_02()
Dim wsIn As Worksheet: Set wsIn = Worksheets("49In")
Dim wsOut As Worksheet: Set wsOut = Worksheets("49Out")
Dim rng As Range
Set rng = wsIn.Range("A1").CurrentRegion
wsIn.AutoFilterMode = False
wsOut.Range("A1").CurrentRegion.Offset(1).Clear
Call setDisplayFormat(wsOut, rng, 4, vbRed, xlFilterFontColor)
Call setDisplayFormat(wsOut, rng, 4, vbRed, xlFilterCellColor)
Call setDisplayFormat(wsOut, rng, 4, vbYellow, xlFilterCellColor)
wsOut.Range("A1").CurrentRegion.Sort key1:=wsOut.Range("A1"), Header:=xlYes
wsIn.AutoFilterMode = False
End Sub
Sub setDisplayFormat(wsOut As Worksheet, aRng As Range, _
Field As Variant, Criteria1 As Variant, Operator As XlAutoFilterOperator)
Dim rOut1 As Long, rOut2 As Long
rOut1 = wsOut.Cells(wsOut.Rows.Count, 1).End(xlUp).Row + 1
aRng.AutoFilter Field:=Field, Criteria1:=Criteria1, Operator:=Operator
aRng.Offset(1).Copy Destination:=wsOut.Cells(rOut1, 1)
rOut2 = wsOut.Cells(wsOut.Rows.Count, 1).End(xlUp).Row
With wsOut.Cells(rOut1, Field).Resize(rOut2 - rOut1 + 1)
.ClearFormats
Select Case Operator
Case xlFilterFontColor
.Font.Color = Criteria1
Case xlFilterCellColor
.Interior.Color = Criteria1
End Select
End With
End Sub
サイト内関連ページ
第91回．条件付き書式（FormatCondition）｜VBA入門
・FormatConditionsコレクション ・FormatConditionオブジェクト ・条件付き書式のマクロVBA実践例 ・マクロVBAの条件付き書式について
第21回．条件付き書式｜VBA再入門非常に便利で、ぜひ使いこなしたい機能の１つに、条件付き書式があります。今回は、この条件付き書式をマクロの記録をしてみましよう。では、マクロの記録ですが、バージョンによって操作が違うので、まずは、2007、2010です。
増殖した条件付き書式を整理統合する｜VBAサンプル・条件付き書式の増殖に関する、Microsoft サポート ・増殖した条件付き書式の実例と対応 ・簡単なVBAでの対応 ・VBAで条件付き書式を整理統合した結果 ・今回のVBAコードの発想について ・Application.ConvertFormulaメソッド ・増殖した条件付き書式を整理統合するVBA ・条件付き書式で設定できる書式 ・増殖した条件付き書式を整理統合するVBAの使い方 ・増殖した条件付き書式を整理統合の最後
条件付き書式で変更された書式を取得する｜VBAサンプル条件付き書式が設定されている場合、当然ですが見た目は、本来そのセルに設定されている書式ではなく、条件付き書式の条件によって設定されている書式になります。VBAで、この条件付き書式によって設定された書式を取得します。これが取得できるようになったのは、Excel2010からですので、このページで紹介するVBAコードはE…
同じテーマ「VBA100本ノック」の記事
・出題 ・頂いた回答 ・解説 ・補足 ・サイト内関連ページ
47本目：Window操作・出題 ・頂いた回答 ・解説 ・補足 ・サイト内関連ページ
48本目：配列と数値型・出題 ・頂いた回答 ・解説 ・補足 ・サイト内関連ページ
49本目：条件付き書式の判定50本目：トリボナッチ数列
・出題 ・頂いた回答 ・解説 ・補足 ・サイト内関連ページ
51本目：シート一覧と印刷ページ数・出題 ・頂いた回答 ・解説 ・補足 ・サイト内関連ページ
52本目：複数シートの一括印刷・出題 ・頂いた回答 ・解説 ・補足 ・サイト内関連ページ
53本目：テーブルの扱いと年齢計算・出題 ・頂いた回答 ・解説 ・補足 ・サイト内関連ページ
54本目：シートのChangeイベント・出題 ・頂いた回答 ・解説 ・補足 ・サイト内関連ページ
55本目：他ブックのマクロを起動・出題 ・頂いた回答 ・解説 ・補足 ・サイト内関連ページ
56本目：数式内の自身のシート名を消す・出題 ・頂いた回答 ・解説 ・補足 ・サイト内関連ページ
新着記事NEW ・・・新着記事一覧を見る
ブール型（Boolean）のis変数・フラグについて｜VBA技術解説(2024-04-05)
テキストの内容によって図形を削除する｜VBA技術解説(2024-04-02)
ExcelマクロVBA入門目次｜エクセルの神髄(2024-03-20)
VBA10大躓きポイント（初心者が躓きやすいポイント）｜VBA技術解説(2024-03-05)
テンキーのスクリーンキーボード作成｜ユーザーフォーム入門(2024-02-26)
無効な前方参照か、コンパイルされていない種類への参照です。｜エクセル雑感(2024-02-17)
初級脱出10問パック｜VBA練習問題(2024-01-24)
累計を求める数式あれこれ｜エクセル関数応用(2024-01-22)
複数の文字列を検索して置換するSUBSTITUTE｜エクセル入門(2024-01-03)
いくつかの数式の計算中にリソース不足になりました。｜エクセル雑感(2023-12-28)
アクセスランキング ・・・ ランキング一覧を見る
1.最終行の取得（End,Rows.Count）｜VBA入門
2.セルのコピー&値の貼り付け（PasteSpecial）｜VBA入門
3.RangeとCellsの使い方｜VBA入門
4.ひらがな⇔カタカナの変換｜エクセル基本操作
5.繰り返し処理（For Next)｜VBA入門
6.変数宣言のDimとデータ型｜VBA入門
7.ブックを閉じる・保存（Close,Save,SaveAs）｜VBA入門
8.並べ替え（Sort）｜VBA入門
9.セルのクリア（Clear,ClearContents）｜VBA入門
10.Findメソッド（Find,FindNext,FindPrevious）｜VBA入門
- ホーム
- マクロVBA入門編
- VBA100本ノック
- 49本目：条件付き書式の判定
このサイトがお役に立ちましたら「シェア」「Bookmark」をお願いいたします。
記述には細心の注意をしたつもりですが、
間違いやご指摘がありましたら、「お問い合わせ」からお知らせいただけると幸いです。
掲載のVBAコードは動作を保証するものではなく、あくまでVBA学習のサンプルとして掲載しています。
掲載のVBAコードは自己責任でご使用ください。万一データ破損等の損害が発生しても責任は負いません。