excel 在工作表1中查找单元格值,并查看工作表2的列中是否存在值

hpcdzsge  于 2023-03-04  发布在  其他
关注(0)|答案(2)|浏览(223)

我正在处理一个文档,以确认特定的值是否存在,在文本文档的特定顺序。
本质上,我试图确定的是,工作表1(活动)上单元格B2中的字符串值是否存在于工作表2(主列表)上的字符串值列中。
如果字符串值确实存在,则单元格应突出显示绿色,如果不存在,则突出显示红色,然后向下移动到表1上的下一列值(即B3)(如果有)
我知道我必须使用for循环,但不是100%确定要在循环中使用的特定函数
如果您能提供任何帮助,我们将不胜感激。谢谢大家。
我想到的最接近的

Dim WS As Worksheet
Set WS = Sheets("Master List")
Dim WS1 As Worksheet
Set WS1 = Sheets("Campaign")

For i = 2 To 100
  For j = 2 to 100
' Loop through the Master sheet
      If WS1.Cells(i, 2) = WS.Cells(i, 2) Then
         ' If a match is found update color:
               Selection.Interior
               .Pattern = xlSolid
               .PatternColorIndex = xlAutomatic
               .Color = 5287936
               .TintAndShade = 0
               .PatternTintAndShade = 0
      Else If WS1.Cells(i, 2) <> WS.Cells(i, 2) Then
         ' If cell doesn't match is found update color:
               Selection.Interior
               .Pattern = xlSolid
               .PatternColorIndex = xlAutomatic
               .Color = 5287936
               .TintAndShade = 0
               .PatternTintAndShade = 0
     End if
  Next j  
Next i
ipakzgxi

ipakzgxi1#

如果必须使用VBA,则类似下面这样的代码应该适用于您:

Sub FindValues()
    
    Dim wb As Workbook:         Set wb = ThisWorkbook
    Dim wsCmpn As Worksheet:    Set wsCmpn = wb.Worksheets("Campaign")
    Dim wsMstr As Worksheet:    Set wsMstr = wb.Worksheets("Master List")
    Dim rFindValues As Range:   Set rFindValues = wsCmpn.Range("B2", wsCmpn.Cells(wsCmpn.Rows.Count, "B").End(xlUp))
    If rFindValues.Row < 2 Then Exit Sub    'No values to find
    
    Dim rCell As Range
    Dim rFound As Range
    Dim rGreen As Range
    Dim rRed As Range
    
    'xlWhole for exact match
    'xlPart for partial match
    Dim lMatchType As Long: lMatchType = xlWhole
    
    For Each rCell In rFindValues.Cells
        If Len(rCell.Value) > 0 Then 'Ignore blanks
            Set rFound = wsMstr.Columns("B").Find(rCell.Value, , xlValues, lMatchType, MatchCase:=False)
            If rFound Is Nothing Then
                Select Case (rRed Is Nothing)
                    Case True:  Set rRed = rCell
                    Case Else:  Set rRed = Union(rRed, rCell)
                End Select
            Else
                Select Case (rGreen Is Nothing)
                    Case True:  Set rGreen = rCell
                    Case Else:  Set rGreen = Union(rGreen, rCell)
                End Select
                Set rFound = Nothing
            End If
        End If
    Next rCell
    
    rFindValues.EntireColumn.Interior.ColorIndex = xlNone
    If Not rRed Is Nothing Then rRed.Interior.Color = vbRed
    If Not rGreen Is Nothing Then rGreen.Interior.Color = vbGreen
    
End Sub
xuo3flqw

xuo3flqw2#

突出显示匹配的单元格

Option Explicit

Sub HighlightCampaign()

    Dim wb As Workbook: Set wb = ThisWorkbook ' workbook containing this code
    
    Dim sws As Worksheet: Set sws = wb.Sheets("Master List")
    Dim srg As Range
    Set srg = sws.Range("B2", sws.Cells(sws.Rows.Count, "B").End(xlUp))
    
    Dim dws As Worksheet: Set dws = wb.Sheets("Campaign")
    Dim drg As Range
    Set drg = dws.Range("B2", dws.Cells(dws.Rows.Count, "B").End(xlUp))
    
    Dim dCell As Range
    
    For Each dCell In drg.Cells
        If IsNumeric(Application.Match(dCell.Value, srg, 0)) Then
            dCell.Interior.Color = 14348258 ' Green
        Else
            dCell.Interior.Color = 14083324 ' Red
        End If
    Next dCell
    
    MsgBox "Campaign values highlighted.", vbInformation

End Sub

相关问题