Выберите только значение в соответствии с выделенными ячейками

Question

Я пытаюсь код, который выберет значение из выпадающего списка проверки данных, только если ячейка, которая находится в двух блоках слева, выделена.Но я не могу понять, как это сделать.Может кто-нибудь помочь, пожалуйста?Спасибо

У меня есть следующий код, который неправильный, но только в качестве примера:

Sub AssignBided()
Worksheets("Monday").Select
With Worksheets("Monday")
    If Hilight.range("B12") = True Then
        range("B12").Activate
        ActiveCell.Offset(0, -2).Select
        .Selection.Value = "ABC"
    End If
End With
End Sub

Код для выделения ячеек выглядит следующим образом:

Sub Hilight(RNG As range, Hilight As Boolean)
    With RNG.Interior
        If Hilight Then
            .Pattern = xlSolid
            .PatternColorIndex = xlAutomatic
            .Color = RGB(100, 250, 150)
            .TintAndShade = 0
            .PatternTintAndShade = 0
        Else
            .Pattern = xlNone
            .PatternTintAndShade = 0
        End If
    End With
End Sub

ПодсветкаSub используется следующим образом:

Dim L8Product As String
Dim i As Long
Dim L8Rnge As range
L8Product = range("Line8_P_Mon")
'Line 8 Resource requirement code
'Determine if change was made in cell B39
If Not Intersect(Target, Me.range("Line8_P_Mon")) Is Nothing Then
        Hilight range("Line8_Hilight_Mon"), False
'Below Code searches in the KP and Osgood Table and then highlights the 
appropriate cells
    If Trim(L8Product) <> "" Then
        With Sheets("Products").range("KP_Table")                     
'searchs in the KP Table on Sheet Overtime_Pos_Table

            'The code below will search the KP table for the product that you will select from the Line 8 drop down
            Set L8Rnge = .Find(what:=L8Product, _
                            after:=.Cells(.Cells.Count), _
                            LookIn:=xlValues, _
                            lookat:=xlWhole, _
                            searchorder:=xlByRows, _
                            searchdirection:=xlNext, _
                            MatchCase:=False)
            If Not L8Rnge Is Nothing Then
                    Hilight range("KP_Hilight_Mon"), True               
'Hilights the cells for the KP and the Prep material required
            Else: With Sheets("Products").range("Osgood_Table")
                    Set L8Rnge = .Find(what:=L8Product, _
                                    after:=.Cells(.Cells.Count), _
                                    LookIn:=xlValues, _
                                    lookat:=xlWhole, _
                                    searchorder:=xlByRows, _
                                    searchdirection:=xlNext, _
                                    MatchCase:=False)
                    If Not L8Rnge Is Nothing Then
                            Hilight range("Osgood_Hilight_Mon"), True   
'Hilights the cells for the Osgood and the Prep material required
                    End If
                  End With
            End If
        End With
    Else: Hilight range("Line8_Hilight_Mon"), False
    End If
End If

Надеюсь, вопрос ясен.Заранее спасибо.

Answer 1

Вы можете создать простую функцию для проверки выделения ...

'use a constant to store the highlight color, since it's used
'   in multiple places in your code
Const HIGHLIGHT_COLOR = 9894500 'RGB(100, 250, 150)

Sub AssignBided()
    With Worksheets("Monday")
        If IsHighlighted(.Range("B12")) Then
            .Range("B12").Offset(0, 2).Value = "ABC" 'changed offset from -2...
        End If
    End With
End Sub

'Is a cell highlighted? EDIT: changed the function name to IsHighlighted
Function IsHighlighted(c As Range)
    IsHighlighted = (c.Interior.Color = HIGHLIGHT_COLOR)
End Function


Sub Hilight(RNG As Range, Hilight As Boolean)
    With RNG.Interior
        If Hilight Then
            .Pattern = xlSolid
            .PatternColorIndex = xlAutomatic
            .Color = HIGHLIGHT_COLOR '<< use contant here
            .TintAndShade = 0
            .PatternTintAndShade = 0
        Else
            .Pattern = xlNone
            .PatternTintAndShade = 0
        End If
    End With
End Sub