Зацикливание кода VBA для проверки выделенных ячеек

Question

Я хотел бы, чтобы код проверял каждую ячейку в диапазоне A1: A14, и если ячейка выделена, скажите да или нет в столбце B.

.

Sub highlighted()

 Dim rng As Range
 Dim c As Range

    Set rng = ActiveCell

    For Each c In rng

      If c.Interior.Pattern <> xlNone Then

        ActiveCell.Offset(0, 1).Range("A1").Select
        ActiveCell.FormulaR1C1 = "Yes"

    Exit Sub

    End If

  Next c

End Sub

Этот код успешно работает для одной выделенной ячейки, как я могу сделать так, чтобы он циклически проходил через желаемый диапазон, а также включал "нет" для невыделенных ячеек?

Заранее спасибо!

Answer 1

Это будет код. Прочитайте комментарии и настройте их в соответствии с вашими потребностями.

Sub highlighted()

    Dim evaluatedRange As Range
    Dim evaluatedCell As Range

    Dim sheetName As String
    Dim rangeAddress As String

    ' Adjust these two parameters
    sheetName = "Sheet1"                         ' Sheet name where the range is located
    rangeAddress = "A1:A14"

    Set evaluatedRange = ThisWorkbook.Worksheets(sheetName).Range(rangeAddress)

    ' This will loop through each cell in the range
    For Each evaluatedCell In evaluatedRange

        ' Evaluates if the cell has a pattern (what ever it is)
        If evaluatedCell.Interior.Pattern <> xlNone Then

            ' Set the value of the cell next to the one evaluated (same row - rowOffset:=0 but next column columnOffset:=1) to Yes
            evaluatedCell.Offset(rowOffset:=0, columnOffset:=1).Value = "Yes"

            ' Exit Sub -> This would exit the whole process, so if you want to evaluate the whole range, just delete this line
        Else

            evaluatedCell.Offset(rowOffset:=0, columnOffset:=1).Value = "No"

        End If

    Next evaluatedCell

    MsgBox "Process finished!" ' -> alert the user...

End Sub

Если это то, что вам нужно, не забудьте пометить ответ, чтобы помочь другим.

Answer 2

Если я понимаю, что вы пытаетесь сделать, вы можете просто сделать:

Sub highlighted()
   Dim rng As Range
   Dim c As Range

   Set rng = Range("A1:A14")
   For Each c In rng
        If c.Interior.Pattern <> xlNone Then 
            c.Range("A1").Offset(0,1).Value = "Yes"
        End If
   Next c
End Sub

См. Как избежать использования Select в Excel VBA для советов по избежанию ненужных Selects