Excel VBA: セルの文字色変更がうまくいかない場合の解決法

Excel VBAを使用して、特定のセルに数字を入力すると、その横のセルに文字を入力して文字色を変更したいというケースがあります。この記事では、コードの問題点を解決する方法を解説します。

1. 問題のコードと状況の確認
2. 文字色が変更されない理由と対策
3. 修正案: 文字色を変更する正しい方法
4. コード全体を見直して効率化する方法
5. まとめ

1. 問題のコードと状況の確認

質問者が提示したコードでは、セルに特定の数字を入力すると、指定したセルに文字が入力され、その文字の色を変更しようとしていますが、文字色が変更されない問題が発生しています。

Private Sub worksheet_change(ByVal Target As Range)
If Not Intersect(Target, Range("B:B")) Is Nothing Then
If IsNumeric(Target.Value) Then
If Target.Value = 9993 Then
Application.EnableEvents = False
Target.Offset(0, 16).Value = "a"
With Selection.Font
.Color = -3342337
.TintAndShade = 0
End With
Target.Offset(0, 361).Value = "a"
With Selection.Font
.Color = -3342337
.TintAndShade = 0
End With
Application.EnableEvents = True
End If
End If
End If

コード自体に問題があるかもしれませんが、まずはどの部分が正しく動作していないかを特定することが重要です。

2. 文字色が変更されない理由と対策

問題のコードを確認すると、文字色を変更しようとする部分で`Selection.Font.Color`を使用していますが、この部分は`Selection`オブジェクトに依存しています。`Selection`が正しく設定されていない場合、文字色が変更されない可能性があります。

具体的には、`Selection`は現在選択されているセル範囲を指しますが、コード内では`Selection`を変更せずに`Target.Offset`を使って別のセルに文字を入力しているため、文字色を変更しようとしているセルが正しく選択されていない状態です。

3. 修正案: 文字色を変更する正しい方法

文字色を変更するには、`Target.Offset`で指定したセルに対して直接フォントのプロパティを設定する必要があります。以下のように、対象セルに対して直接フォントの色を変更するコードを使うと良いでしょう。

Target.Offset(0, 16).Value = "a"
Target.Offset(0, 16).Font.Color = -3342337
Target.Offset(0, 16).Font.TintAndShade = 0
Target.Offset(0, 361).Value = "a"
Target.Offset(0, 361).Font.Color = -3342337
Target.Offset(0, 361).Font.TintAndShade = 0

これにより、指定したセルに文字が入力され、フォントの色も変更されるようになります。

4. コード全体を見直して効率化する方法

コードを効率化するために、同じ処理が何度も繰り返されている部分を関数化することも検討できます。以下はその例です。

Private Sub worksheet_change(ByVal Target As Range)
If Not Intersect(Target, Range("B:B")) Is Nothing Then
If IsNumeric(Target.Value) Then
If Target.Value = 9993 Then
Application.EnableEvents = False
SetFontColor Target.Offset(0, 16)
SetFontColor Target.Offset(0, 361)
Application.EnableEvents = True
End If
End If
End If
End Sub

Private Sub SetFontColor(cell As Range)
cell.Value = "a"
cell.Font.Color = -3342337
cell.Font.TintAndShade = 0
End Sub