VBAドロップダウンリストからコードを選択します。一部のセルを色で塗りつぶす

Question

私はVBAで新しく、少し苦労しています。
私はレポートを作成しています。レポートでは、私は花とリストをドロップダウンしている、リリー、ローズなどを言いましょう。だから私はローズを選択すると、いくつかの特定の細胞が色を取得したい。私はスプレッドシートをできるだけ小さなサイズにしておく必要があるので、条件付き書式を使用したくありません。 は、これまでのところ私は

Private Sub workbook_sheetchange(ByVal Sh As Object, ByVal Targer As Rang 
Select Case Range("B2") 

Case " Rose" 

Application.Goto Reference:="Header" 
With Selection.Interior 
    .Pattern = xlSolid 
    .PatternColorIndex = xlAutomatic 
    .ThemeColor = xlThemeColorAccent6 
    .TintAndShade = -0.249977111117893 
    .PatternTintAndShade = 0 

End With 

Application.Goto Reference:="Row" 
With Selection.Interior 
    .Pattern = xlSolid 
    .PatternColorIndex = xlAutomatic 
    .ThemeColor = xlThemeColorAccent6 
    .TintAndShade = -0.249977111117893 
    .PatternTintAndShade = 0 

End With 

Application.Goto Reference:="Fill" 

With Selection.Interior 
    .Pattern = xlSolid 
    .PatternColorIndex = xlAutomatic 
    .ThemeColor = xlThemeColorAccent6 
    .TintAndShade = 0.599993896298105 
    .PatternTintAndShade = 0 

End With 
End Select 
End Sub 

を得た任意の助けをありがとう！

Answer 1

あなたはこの後ことがあります、より効果的にリファクタリングすることができ

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range) 

    If Target.Address <> "$B$2" Then Exit Sub '<--| exit if "changed" cell is not "B2" 

    With Sh '<--| reference sheet with "changed" cell 
     Select Case .Range("B2").Value '<--| act with respect to B2 cell current value 
      Case "Rose" 
       With .Range("Header").Interior '<--| reference the specific named range instead of using 'Application.GoTo' method and 'Selection' object 
        .Pattern = xlSolid 
        .PatternColorIndex = xlAutomatic 
        .ThemeColor = xlThemeColorAccent6 
        .TintAndShade = -0.249977111117893 
        .PatternTintAndShade = 0 
       End With 

       With .Range("Row").Interior '<--| reference the specific named range instead of using 'Application.GoTo' method and 'Selection' object 
        .Pattern = xlSolid 
        .PatternColorIndex = xlAutomatic 
        .ThemeColor = xlThemeColorAccent6 
        .TintAndShade = -0.249977111117893 
        .PatternTintAndShade = 0 
       End With 

       With .Range("Fill").Interior '<--| reference the specific named range instead of using 'Application.GoTo' method and 'Selection' object 
        .Pattern = xlSolid 
        .PatternColorIndex = xlAutomatic 
        .ThemeColor = xlThemeColorAccent6 
        .TintAndShade = 0.599993896298105 
        .PatternTintAndShade = 0 
       End With 
     End Select 
    End With 
End Sub 

：

Option Explicit 

Private Sub workbook_sheetchange(ByVal Sh As Object, ByVal Target As Range) 

    If Target.Address <> "$B$2" Then Exit Sub '<--| exit if "changed" cell is not "B2" 

    With Sh '<--| reference sheet with "changed" cell 
     Select Case .Range("B2") '<--| act with respect to B2 cell current value 
      Case "Rose" 
       FormatCell Union(.Range("Header"), .Range("Row"), .Range("Fill")), _ 
          xlSolid, _ 
          xlAutomatic, _ 
          xlThemeColorAccent6, _ 
          -0.249977111117893, _ 
          0 '<--| reference all listed named ranges and format their 'Interior' object with passed properties 
       .Range("Fill").Interior.TintAndShade = 0.599993896298105 '<--| change only "Fill" named range 'Interior' 'TintAndShade' property 
     End Select 
    End With 
End Sub 

Sub FormatCell(cell As Range, pttrn As XlPattern, pttrnClrIndx As XlColorIndex, thmClr As XlThemeColor, tntAndShd As Single, pttrnTntAndShd As Variant) 
    With cell.Interior 
     .pattern = pttrn 
     .PatternColorIndex = pttrnClrIndx 
     .ThemeColor = thmClr 
     .TintAndShade = tntAndShd 
     .PatternTintAndShade = pttrnTntAndShd 
    End With 
End Sub 

Answer 2

なぜファイルサイズが心配ですか？条件付き書式設定を使用するのと同じように正確に機能するブックを作成しました。ファイルサイズは10.5KBです。

あなたが本当にVBAでこれを実行したい場合：

1 - B2は

Private Sub Worksheet_Change(ByVal Target As Range) 
    If Not Application.Intersect(Range("B2"), Range(Target.Address)) Is 
      MsgBox "Cell B2 has been changed" 
    End If 
End Sub 

2ワークシートの変更イベントを使用することによって変更されているかどうかを検出 - あなたのドロップダウンボックスに対するあなたのデータの各セルをテスト。この例では、データがA1からA10の範囲にあると仮定しています。

For Row = 1 To 10 
    If Range("A" & Row).Value = Range("B2").Value Then 
     'Colour your cell 
    Else 
     'Clear the colour from your cell 
    End If 
Next Row 

これでうまくいけばうれしいです。