【Excel VBA】塗りつぶしたセルの色コードを取得し、別のセルを塗りつぶす

■塗り潰し色のコードを取得する

Excel VBAにて、塗りつぶした色のコードを取得するには以下の通りである。

変数 = Sheets("シート名").Cells(行番号, 列番号).Interior.Color

■塗り潰し色コードからセルを塗りつぶす

Excel VBAにて、塗りつぶし色コードからセルを塗りつぶすコードは以下の通り

Sheets("シート名").Cells(行番号, 列番号).Interior.Color = 色コード番号

■実装するプログラムの概要

今回は以下、2つの処理を実装する。

・「コード取得」ボタン押下時の処理
赤、青、緑色で塗り潰したセルから、色コードを取得し、セルに出力する。

・「色塗り」ボタン押下処理
取得した赤、青、緑色の色コードを使用して、特定のセルを塗りつぶす。

▼定数

今回使用する定数を以下に示す。
なお、[定数]、[「コード取得」ボタン押下時の処理]、[「色塗り」ボタン押下処理]は、ThisWorkBookに記載するため、定数はすべてPrivateとする。

' シート名の定数
Private Const SHEETNAME_GETCOLOR As String = "色コード取得"
Private Const SHEETNAME_COLORING As String = "色塗り"

' シート共通定数
Private Const STRAT_ROW As Integer = 3  ' 表の開始行
Private Const STRAT_COL As Integer = 3  ' 表の開始列

' 「色コード取得」シートの定数
Private Const COLOR_COL As Integer = 5              ' 塗りつぶした色の列
Private Const PRINT_COLOR_CODE_COL As Integer = 6   ' カラーコード出力列

' 「色塗り」シートの定数
Private Const COLORING_COL As Integer = 4   ' 色塗り列

▼「コード取得」ボタン押下時の処理

「コード取得」ボタン押下時の処理のフローチャート、プログラム仕様、サンプルコード、実行結果を示す。

・フローチャート

・プログラム仕様

・サンプルコード

Option Explicit
' 「コード取得」ボタン押下時の処理
Public Sub Btn_Click_GetColorCode()

    Dim sht_get_color_code  As Worksheet    ' 「色コード取得」シートを格納する変数
    Dim irow                As Integer      ' 行カウンタ
    
    ' シート名をセット
    Set sht_get_color_code = Sheets(SHEETNAME_GETCOLOR)
    
    ' 初期値をセット
    irow = STRAT_ROW
    
    ' 「色コード取得」シートにフォーカス
    With sht_get_color_code
    
        ' 表の最後まで繰り返し
        Do Until .Cells(irow, STRAT_COL).Value = ""
        
            ' 表の「色」列から、塗りつぶした色のコードを取得し、「コード」列に出力
            .Cells(irow, PRINT_COLOR_CODE_COL).Value = .Cells(irow, COLOR_COL).Interior.Color
            
            ' インクリメント
            irow = irow + 1
        
        Loop
    
    End With
    
    ' シート解放（終了処理）
    Set sht_get_color_code = Nothing

End Sub

・実行結果

・「コード取得」ボタン押下時の処理

「コード取得」ボタンを押下

「コード」列に塗りつぶしの色コードを出力する。

▼「色塗り」ボタン押下処理

「色塗り」ボタン押下時の処理のフローチャート、プログラム仕様、サンプルコード、実行結果を示す。

・フローチャート

・プログラム仕様

・サンプルコード

Option Explicit
'「色塗り」ボタン押下処理
Public Sub Btn_Click_Coloring()

    Dim sht_get_color_code  As Worksheet    ' 「色コード取得」シートを格納する変数
    Dim shte_coloring       As Worksheet    ' 「色塗り」シートを格納する変数
    Dim irow_get_color      As Integer      ' 行カウンタ（色コード取得シート）
    Dim irow_coloring       As Integer      ' 行カウンタ（色塗りシート）

    ' シート名をセット
    Set sht_get_color_code = Sheets(SHEETNAME_GETCOLOR)
    Set shte_coloring = Sheets(SHEETNAME_COLORING)
    
    ' 初期値をセット
    irow_get_color = START_ROW
    irow_coloring = STRAT_ROW
    
    ' 「色塗り」シートにフォーカス
    With shte_coloring
    
        ' 表の最後まで繰り返し
        Do Until .Cells(irow_get_color, STRAT_COL).Value = ""
        
            ' 「色コード取得」シートから、色コードを取得し、その色で「色塗り」シートに塗りつぶしを実施
            .Cells(irow_get_color, COLORING_COL).Interior.Color = sht_get_color_code.Cells(irow_coloring, PRINT_COLOR_CODE_COL).Value
            
            ' インクリメント
            irow_get_color = irow_get_color + 1
            irow_coloring = irow_coloring + 1
        
        Loop
        
    End With

End Sub

・実行結果

「色塗り」ボタンを押下

それぞれの色で塗りつぶしする。