49本目 条件付き書式の判定

VBA100本ノック 49本目を動画で解説しています。Excelの神髄さんの模範解答はコチラ

---

問題

#VBA100本ノック49本目
D列には以下の条件付き書式が設定されています。
・文字色(赤)
・塗りつぶし(赤,黄)
条件が適用されている行を別シートに値を転記し、同じ文字色と塗りつぶしをセルの書式に設定してください。
※元セルは書式設定されていません。
※転記元と転記先シートは任意

解答

Sub 元データを別シートにコピー()

    Dim wsIn As Worksheet:       Set wsIn = Sheets("49In")
    Dim wsOut As Worksheet: Set wsOut = Sheets("49Out")
    wsOut.Cells.Clear
    wsIn.Range("A1").CurrentRegion.Copy wsOut.Range("A1")
    
    Dim i, lastrow
    lastrow = wsOut.Cells(Rows.Count, 1).End(xlUp).Row
    For i = 2 To lastrow
        With wsOut.Cells(i, 4)
            If .DisplayFormat.Font.Color ＜＞ 0 Or _
               .DisplayFormat.Interior.Color ＜＞ 16777215 Then
               .Font.Color = .DisplayFormat.Font.Color
               .Interior.Color = .DisplayFormat.Interior.Color
            End If
        End With
    Next i
    For i = lastrow To 2 Step -1
        With wsOut.Cells(i, 4)
            If .DisplayFormat.Font.Color = 0 And _
               .DisplayFormat.Interior.Color = 16777215 Then
               Rows(i).Delete
            End If
        End With
    Next i
    wsOut.Cells.FormatConditions.Delete 'シートの書式設定を解除

End Sub