У меня есть диапазон ячеек (K6: M200) на моем листе «Сводка», в котором мне нужно использовать макрос, чтобы выбрать все ячейки, которые окрашены на основе условного форматирования. Есть следующие условия:

  1. Цветные ячейки будут непрерывными от K6 до тех пор, пока какой-либо ряд не будет соответствовать условию.
  2. Не все клетки будут одинакового цвета.

Я новичок в VBA и макросах, так что я надеюсь, что кто-нибудь поможет мне разобраться, как это сделать. Я уже пробовал несколько формул, и это не сработало.

0
Kendra 11 Сен 2017 в 11:31

3 ответа

Лучший ответ

Я понял, что, поскольку я знаю первое значение, и часть моего макроса ранее выбирает весь диапазон, который будет окрашен, я мог бы построить диапазон, используя эти два значения.

Так я и сделал:

Dim r1 As Range, r2 As Range
Set r1 = Selection
Set r2 = ActiveSheet.Range("K6")
Range(r2, r1).Select

И это сработало. Я просто подхожу к этому неправильно.

0
Kendra 11 Сен 2017 в 18:22

Я бы предложил что-то вроде этого:

Sub selectCFColours()
    Dim cell As Range
    Dim selRange As Range

    For Each cell In Range("K6:M200")
        If cell.DisplayFormat.Interior.Color <> cell.Interior.Color Then
            If selRange Is Nothing Then
                Set selRange = cell
            Else
                Set selRange = Union(selRange, cell)
            End If
        End If
    Next

    If Not selRange Is Nothing Then selRange.Select
End Sub
2
Rory 11 Сен 2017 в 08:45

Следующий код предназначен для общего кода FindAll. Это также можно использовать, установив Application.FindFormat, чтобы его можно было использовать с условным форматированием.

Sub FindBlack()
    Dim FoundRange As Range

    With Application.FindFormat
        .Clear
        .Interior.Color = RGB(0, 0, 0)
    End With
    Set FoundRange = FindAll("", LookIn:=xlFormulas, SearchWhat:=Range("K6:M200"), SearchFormat:=True)

    If Not FoundRange Is Nothing Then Debug.Print FoundRange.Address
End Sub

Function FindAll(What, _
    Optional SearchWhat As Variant, _
    Optional LookIn, _
    Optional LookAt, _
    Optional SearchOrder, _
    Optional SearchDirection As XlSearchDirection = xlNext, _
    Optional MatchCase As Boolean = False, _
    Optional MatchByte, _
    Optional SearchFormat) As Range

    'LookIn can be xlValues or xlFormulas, _
     LookAt can be xlWhole or xlPart, _
     SearchOrder can be xlByRows or xlByColumns, _
     SearchDirection can be xlNext, xlPrevious, _
     MatchCase, MatchByte, and SearchFormat can be True or False. _
     Before using SearchFormat = True, specify the appropriate settings for the Application.FindFormat _
     object; e.g. Application.FindFormat.NumberFormat = "General;-General;""-"""

    Dim SrcRange As Range
    If IsMissing(SearchWhat) Then
        Set SrcRange = ActiveSheet.UsedRange
    ElseIf TypeOf SearchWhat Is Range Then
        Set SrcRange = IIf(SearchWhat.Cells.Count = 1, SearchWhat.Parent.UsedRange, SearchWhat)
    ElseIf TypeOf SearchWhat Is Worksheet Then
        Set SrcRange = SearchWhat.UsedRange
    Else: SrcRange = ActiveSheet.UsedRange
    End If
    If SrcRange Is Nothing Then Exit Function

    'get the first matching cell in the range first
    With SrcRange.Areas(SrcRange.Areas.Count)
        Dim FirstCell As Range: Set FirstCell = .Cells(.Cells.Count)
    End With

    Dim CurrRange As Range: Set CurrRange = SrcRange.Find(What:=What, After:=FirstCell, LookIn:=LookIn, LookAt:=LookAt, _
        SearchDirection:=SearchDirection, MatchCase:=MatchCase, MatchByte:=MatchByte, SearchFormat:=SearchFormat)

    If Not CurrRange Is Nothing Then
        Set FindAll = CurrRange
        Do
            Set CurrRange = SrcRange.Find(What:=What, After:=CurrRange, LookIn:=LookIn, LookAt:=LookAt, _
            SearchDirection:=SearchDirection, MatchCase:=MatchCase, MatchByte:=MatchByte, SearchFormat:=SearchFormat)
            If CurrRange Is Nothing Then Exit Do
            If Application.Intersect(FindAll, CurrRange) Is Nothing Then
                Set FindAll = Application.Union(FindAll, CurrRange)
            Else: Exit Do
            End If
        Loop
    End If
End Function
0
Tragamor 11 Сен 2017 в 09:24