问VB将4列信息与多个数据点进行比较，然后突出显示
EN

Stack Overflow用户

提问于 2021-06-27 12:19:16

回答 1查看 21关注 0票数 0

ColumnsExample我试着比较四个列的信息。首先将位置1数据与位置2数据进行匹配，然后比较租出的列。

如果位置2租出的列D(对于匹配列A和列C的特定汽车)大于租出的列B，则突出显示单元(列D)黄色。另外，如果租出了D列

一个例子图片(上面的ColumnsExample)将是本田和道奇出租的列D将突出显示这一点。

我假设我将不得不为Daily、Weekly和Monthly分配一个数值来进行比较。只是不知道从哪里开始！

Dim Alert As Range
Dim Daily, Weekly, Monthly As Integer
 Set Daily = 1
 Set Weekly = 2
 Set Monthly = 3
Set ws = ActiveSheet
Set w = ws.Rows(1).Find("Rented Out 2", lookat:=xlWhole)
If Not w Is Nothing Then
For Each Alert In ws.Range(w, ws.Cells(Rows.Count, 
w.Column).End(xlUp)).Cells
        If Alert <= "Daily" Then 
             'Not sure how I can set this condition based on matching 
              'Location 1 with location 2 as well as Rented1 out vs 
              'Rented out 2
            Alert.Interior.Color = 65535
        End If
    Next Alert
End If

excel

vba

highlight

回答 1

Stack Overflow用户

回答已采纳

发布于 2021-06-27 12:54:53

使用Dictionary进行比较，使用函数将字符串转换为数字。

Option Explicit

Sub MyMacro()

    Dim ws As Worksheet, iLastRow As Long, r As Long
    Dim dict As Object, key As String, s As String
    Dim i As Integer
    
    Set dict = CreateObject("Scripting.Dictionary")
    Set ws = ActiveSheet
   
    ' scan col A & B
    iLastRow = ws.Cells(Rows.Count, "A").End(xlUp).Row
    For r = 2 To iLastRow
       key = Trim(ws.Cells(r, "A"))
       If Len(key) > 0 Then
           s = Trim(ws.Cells(r, "B"))
           i = TextToNo(s) ' convert text to number
           If i = 0 Then
               MsgBox "ERROR col B = '" & s & "'", vbCritical, "Row = " & r
               Exit Sub
           End If
       
           ' add to dictionery
           If dict.exists(key) Then
               MsgBox "ERROR col A duplicate key = '" & key & "'", vbCritical, "Row = " & r
               Exit Sub
           Else
               dict.Add key, i
           End If
       End If
    Next

    ' scan col C & D
    iLastRow = ws.Cells(Rows.Count, "C").End(xlUp).Row
    For r = 2 To iLastRow
       key = Trim(ws.Cells(r, "C"))
       
       If Len(key) > 0 Then
          If dict.exists(key) Then
              s = Trim(ws.Cells(r, "D"))
              i = TextToNo(s)
              If i = 0 Then
                  MsgBox "ERROR col D = '" & s & "'", vbCritical, "Row = " & r
                  Exit Sub
              End If
             
              ' compare col D with col B
              If i > dict(key) Then
                  ws.Cells(r, "D").Interior.Color = vbYellow
              Else
                  ws.Cells(r, "D").Interior.Color = vbWhite
              End If
          End If
       End If
    Next
    MsgBox "Finished"

End Sub

Function TextToNo(s As String) As Integer
    Select Case LCase(s)
        Case "daily": TextToNo = 1
        Case "weekly": TextToNo = 2
        Case "monthly": TextToNo = 3
        Case Else: TextToNo = 0
    End Select
End Function