【问题标题】:If statement not changing colors when conditions are metif语句在满足条件时不改变颜色
【发布时间】:2019-03-22 20:56:55
【问题描述】:

我正在使用 Excel VBA 尝试解决以下问题:

在 A 列中,我得到了 42 个国家/地区的列表。在 D 列中,我得到了该国巨无霸的美元价格。第 1 行有标题,因此数据从第 2 行开始。我需要构建一个宏,允许用户输入 2 个国家(国家 1 和国家 2),将遍历 A 列以查找用户输入的国家及其对应的国家价格。它应该将国家的单元格位置保存到某个变量中,而价格只是一个数字。如果 Country1 的价格大于国家 2 的价格,则 Country1 的名称应为绿色,Country2 的字体颜色为红色。反之亦然。

现在,整个代码正在运行。但是单元格的颜色没有改变。

如果你想测试它,这里是表格的顶部:

Sub CountryComparison()

Dim Counter As Integer

Dim Country1 As String
Dim Country2 As String
Dim TheCell As Range
Dim Price1Cell As Range
Dim Price2Cell As Range
Dim Price1 As Single
Dim Price2 As Single

'The user inputs what countries they want to compare

Country1 = InputBox("Enter Country 1")
Country2 = InputBox("Enter Country 2")

'We are starting at row 2, column 1. Since we're going to check every row, I'm making counter a variable so that I can continuously add 1 to it after every loop.

Counter = 2
Set TheCell = Cells(Counter, 1)

'Here's my loop. It will select TheCell, and if it contains the name of Country1, then it will save that cell as Price1Cell (to be used later), and save the price of a Big Mac in that country (also to be used later). It does the same thing for Country2 thanks to the ElseIf statement. And if neither is a match, it goes on to the next row. Since there are 42 rows, it does this until Counter is greater than 43 (maybe it should be until greater than 42, but that shouldn't matter). I'm worried the way I'm saving Price1Cell/Price2Cell is incorrect. Should I be using TheCell instead of ActiveCell? Should I not be using the .Address function? Should I not be using Set and making it an object?... Feel like I've tried everything. This may be the reason for my problem later.

Do

    TheCell.Select

    If ActiveCell.Value = Country1 Then
    Set Price1Cell = Range(ActiveCell.Address)
    Price1 = ActiveCell.Offset(0, 3).Value

    ElseIf ActiveCell.Value = Country2 Then
    Set Price2Cell = Range(ActiveCell.Address)
    Price2 = ActiveCell.Offset(0, 3).Value

    End If

    Counter = Counter + 1

Loop Until Counter > 43

'Here's the final point, and where I seem to be getting my problem. If Country1's price is greater than Country2's Price, then Country1 should be colored red and Country2 green. And vice-versa. I think it might have to do with the way that I defined Price1Cell and Price2Cell. But I've tried a few different ways and got nothing. I tried a couple of different ways of writing my Do Until Loop, but nothing changes. It shouldn't need to be broken up into 2 loops, because I have the ElseIf statement.

If Price1 > Price2 Then
    Price1Cell.Font.Color = vbRed
    Price2Cell.Font.Color = vbGreen
End If

If Price2 > Price1 Then
    Price1Cell.Font.Color = vbGreen
    Price2Cell.Font.Color = vbRed
End If


End Sub

【问题讨论】:

    标签: excel vba colors


    【解决方案1】:

    问题是你的Do 循环中没有Set TheCell,所以它永远不会从Cells(2, 1) 改变。把它移到里面:

    Counter = 2
    
    Do
        Set TheCell = Cells(Counter, 1)
        TheCell.Select
    
        If ActiveCell.Value = Country1 Then
    

    更好的是,完全放弃循环并使用.Find

    Option Explicit
    Sub CountryComparison()
    
        Dim Country1 As String
        Dim Country2 As String
        Dim Price1Cell As Range
        Dim Price2Cell As Range
        Dim Price1 As Single
        Dim Price2 As Single
    
        Range("A:A").Font.Color = vbBlack
    
        Country1 = InputBox("Enter Country 1")
        Country2 = InputBox("Enter Country 2")
    
        Set Price1Cell = Range("A" & Columns("A:A").Find(What:=Country1).Row)
        Set Price2Cell = Range("A" & Columns("A:A").Find(What:=Country2).Row)
    
        Price1 = Range("A" & Columns("A:A").Find(What:=Country1).Row).Offset(0, 3).Value
        Price2 = Range("A" & Columns("A:A").Find(What:=Country2).Row).Offset(0, 3).Value
    
        If Price1 > Price2 Then
            Price1Cell.Font.Color = vbRed
            Price2Cell.Font.Color = vbGreen
        Else
            Price1Cell.Font.Color = vbGreen
            Price2Cell.Font.Color = vbRed
        End If
    
    End Sub
    

    【讨论】:

      猜你喜欢
      • 1970-01-01
      • 1970-01-01
      • 2012-12-17
      • 1970-01-01
      • 1970-01-01
      • 1970-01-01
      • 1970-01-01
      • 1970-01-01
      • 1970-01-01
      相关资源
      最近更新 更多