突出显示包含范围的特定范围

时间:2021-02-22 16:44:25

标签: excel vba

我编写了一个代码来突出显示行的特定长度,即 Sheet7.Range("C12:G12")Sheet7.Range("C" & Rows.Count).End(xlUp).Row

其中 Sheet2.Range("A20") & Sheet2.Range("A21") & Sheet2.Range("A22") 在 Sheet7.Range("C:C") 中匹配

但是我的代码不起作用。您的帮助将不胜感激。

Sub Formatting()

Dim rg As Range

endrow = Range("C" & Rows.Count).End(xlUp).Row
For Each cell In Range("C12:C" & endrow)
 If cell.Value = Sheet2.Range("A20") & Sheet2.Range("A21") & 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" & Rows.Count).End(xlUp).Row
For Each cell In Range("C12:C" & 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

2 个答案:

答案 0 :(得分:1)

由于您设置测试条件的方式,您的代码无法正常工作。它将首先评估 = 右侧的所有内容,然后将其与单元格值进行比较。这将导致(例如)"alpah" = "alphabetagammadelta"

尝试使用类似的方法:

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

答案 1 :(得分:1)

格式化行范围

快速修复

Option Explicit

Sub formatRowRangesQF()
    Dim EndRow As Long
    EndRow = Sheet7.Range("C" & Sheet7.Rows.Count).End(xlUp).Row
    Dim dCell As Range
    For Each dCell In Sheet7.Range("C12:C" & 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