Выделить определенный диапазон, содержащий диапазон

#excel #vba

Вопрос:

Я написал код, чтобы выделить конкретную длину строки, т.Е. Sheet7.Range("C12:G12") с Sheet7.Range("C" amp; Rows.Count).End(xlUp).Row помощью .

Где Sheet2.Range(«A20») amp; Sheet2.Range(«A21») amp; Sheet2.Range(«A22») совпадают с Листом7.Диапазон («C: C»)

но мой код не работает. Мы будем признательны за вашу помощь в решении проблемы.

 Sub Formatting()

Dim rg As Range

endrow = Range("C" amp; Rows.Count).End(xlUp).Row
For Each cell In Range("C12:C" amp; endrow)
 If cell.Value = Sheet2.Range("A20") amp; Sheet2.Range("A21") amp; Sheet2.Range("A22") Then
  cell.Sheet7.Range("C12:G12").Interior.Color = RGB(192, 192, 192)

  End If
Next

End Sub

этот код просто выделяет Sheet7.Range("C12:G12") только эту строку. Он должен идти дальше.

 Sub Local_BACKGROUND()
    endrow = Range("C" amp; Rows.Count).End(xlUp).Row
For Each cell In Range("C12:C" amp; endrow)
  If Not IsError(Application.Match(cell.Value, Sheet2.Range("A20:A23"), 0)) Then
     Sheet7.Range("C12:G12").Interior.Color = RGB(192, 192, 192)
  End If
Next
End Sub

1. Sheet2.Range("A20") amp; Sheet2.Range("A21") amp; Sheet2.Range("A22") эквивалентно "AlphaBetaDelta"

2. Да, @BigBen, вы правы.

3.^^ cell.value = Sheet2.range("A20") OR ....

4. If Not Iserror(Applicatioin.Match(cell.Value, Sheet2.Range("A20:A23"),0)) Then

5. @Mento Я только что попробовал запустить ваш код в образце рабочей книги, и у меня это сработало. Одна вещь , которую я заметил , — это то , что у вас есть опечатка в слове Application . (Вы написали это по буквам Applicatioin). Было ли это просто опечаткой на этом сайте, или ваш код тоже неверен?

Ответ №1:

Форматирование диапазонов строк

Быстрое исправление

 Option Explicit

Sub formatRowRangesQF()
    Dim EndRow As Long
    EndRow = Sheet7.Range("C" amp; Sheet7.Rows.Count).End(xlUp).Row
    Dim dCell As Range
    For Each dCell In Sheet7.Range("C12:C" amp; EndRow)
        If IsNumeric(Application.Match(dCell.Value, _
                Sheet2.Range("A20:A22"), 0)) Then
            dCell.Resize(, 5).Interior.Color = RGB(192, 192, 192)
        End If
    Next
End Sub

Более серьезное решение

 Sub formatRowRanges()
    ' Source
    Dim srg As Range: Set srg = Sheet2.Range("A20:A22")
    ' Destination
    Dim drg As Range
    With Sheet7.Range("C12:G12")
        Dim LastRow As Long
        With .Cells(1)
            LastRow = .Offset(.Worksheet.Rows.Count - .Row).End(xlUp).Row
            If LastRow < .Row Then Exit Sub
        End With
        Set drg = .Resize(LastRow - .Row   1)
    End With
    ' Combine
    Dim trg As Range
    Dim rrg As Range
    Dim cValue As Variant
    For Each rrg In drg.Rows
        cValue = rrg.Cells(1).Value
        If Not IsError(cValue) Then
            If Len(cValue) > 0 Then
                If IsNumeric(Application.Match(cValue, srg, 0)) Then
                    If trg Is Nothing Then
                        Set trg = rrg
                    Else
                        Set trg = Union(trg, rrg)
                    End If
                End If
            End If
        End If
    Next
    ' Color
    If Not trg Is Nothing Then
        drg.Interior.Color = xlNone
        trg.Interior.Color = RGB(192, 192, 192)
    End If
End Sub

Ответ №2:

Ваш код не работает из-за того, как вы настроили условие тестирования. Он оценит все справа от = первого, а затем сравнит его со значением ячейки. Это приведет к (например) "alpah" = "alphabetagammadelta" .

Попробуйте вместо этого что-то вроде:

 if not(iserror(Application.Match(cell.value, Sheet2.Range("A20:A23"), 0))