突出顯示與另一個區域中的任何單元格匹配的區域中的任何單元格

我有 Range1(S4:W8) 和 Range2(J4:N18)。

我想創建一個宏來檢查兩個范圍之間的任何單元格是否彼此相等，如果是，則突出顯示。根據情況，Range2 可能有很少或很多空白單元格。

下面是我的嘗試。“*****”對我來說是一個占位符，因為我不知道該放什么。

Dim R1 As Range
Set R1 = Range("S4:W8")

Dim R2 As Range
Set R2 = Range("J4:N18")

For Each Cell In R1
        If Cell.Value ***** Then
            Cell.Interior.ColorIndex = 6
            
        End If
    Next


End Sub

uj5u.com熱心網友回復：

有很多方法可以做到這一點，但這里有一個簡單的方法可以幫助您理解回圈和范圍。我想你不想對這樣的事情使用條件格式。

為了清楚起見，我稍微改變了你的變數，并添加了一個，exit for因為一旦你匹配了一種顏色就不需要繼續搜索了。

Sub doTHis()
Dim aRng As Range, gRng As Range, aCell As Range, gCell As Range

'probably should scope the sheet too

Set aRng = Range("S4:W8")
Set gRng = Range("J4:N18")

For Each aCell In aRng.Cells
        For Each gCell In gRng.Cells
            If gCell.Value = aCell.Value Then
                aCell.Interior.ColorIndex = 6
                Exit For ' no need to keep searching
            End If
        Next gCell
Next aCell

End Sub

uj5u.com熱心網友回復：

請測驗下一個方法。對于大范圍，使用陣列，將要著色的單元格放置在聯合范圍內并在代碼末尾著色它們應該非常快。它還跳過要比較的空單元格：

Sub testMatchRngValues()
Dim R1 As Range, R2 As Range, rngCol As Range, arr1, arr2, i As Long, j As Long, i1 As Long, j1 As Long

Set R1 = Range("S4:W8"):  arr1 = R1.Value  'place the range in an array for faster interation
Set R2 = Range("J4:N18"): arr2 = R2.Value  'place the range in an array for faster interation

For i = 1 To UBound(arr1)
    For j = 1 To UBound(arr1, 2)
        For i1 = 1 To UBound(arr2)
            For j1 = 1 To UBound(arr2, 2)
                If arr1(i, j) = arr2(i1, j1) And arr1(i, j) <> "" And arr2(i1, j1) <> "" Then
                    If rngCol Is Nothing Then
                        Set rngCol = R1.cells(i, j)
                    Else
                        Set rngCol = Union(rngCol, R1.cells(i, j))
                    End If
                End If
            Next j1
        Next i1
    Next j
Next i
If Not rngCol Is Nothing Then rngCol.Interior.ColorIndex = 6
End Sub

uj5u.com熱心網友回復：

如果您想要簡單的性能，您可以使用以下代碼：

Sub findInRange()

    Dim R1 As Range
    Set R1 = Range("S4:W8")

    Dim R2 As Range
    Set R2 = Range("J4:N18")

    Dim fnd As Range

    ' search R2 for cell in R1
    For Each cell In R1

        Set fnd = R2.Find(cell.Value, lookat:=xlWhole)
        
        If Not fnd Is Nothing Then
            ' colour matched cells
            cell.Interior.ColorIndex = 6
        Else
            ' reset colour in unmatched cells
            cell.Interior.ColorIndex = 0
        End If
    Next

End Sub

uj5u.com熱心網友回復：

突出顯示列匹配

• 這將突出顯示每列的匹配項，即每個范圍具有相同的列數，因此它將在目標范圍的相應列中的單元格中找到源范圍列中的單元格的匹配項，并以黃色突出顯示它們。

Option Explicit

Sub HighlightColumnMatches()
    
    Dim ws As Worksheet: Set ws = ActiveSheet
    
    Dim srg As Range: Set srg = ws.Range("J4:N18")
    
    Dim drg As Range: Set drg = ws.Range("S4:W8")
    Dim drCount As Long: drCount = drg.Rows.Count
    Dim dData As Variant: dData = drg.Value
    
    Dim scrg As Range
    Dim sIndex As Variant
    Dim durg As Range
    Dim dr As Long
    Dim dc As Long
    
    For dc = 1 To drg.Columns.Count
        Set scrg = srg.Columns(dc)
        For dr = 1 To drCount
            sIndex = Application.Match(dData(dr, dc), scrg, 0)
            If IsNumeric(sIndex) Then
                If durg Is Nothing Then
                    Set durg = drg.Cells(dr, dc)
                Else
                    Set durg = Union(durg, drg.Cells(dr, dc))
                End If
            End If
        Next dr
    Next dc
                
    If Not durg Is Nothing Then
        drg.Interior.Color = xlNone
        durg.Interior.Color = vbYellow
    End If

    MsgBox "Matches highlighted.", vbInformation

End Sub

標籤：擅长 vba

上一篇：使用SQL迭代計算字串'6*5 2/8'的輸出

下一篇：VBA將數字之間的值分配給陣列