#excel #vba #colors
#excel #vba #Цвет
Вопрос:
Я использую Excel VBA, чтобы попытаться решить следующую проблему:
В столбце A мне предоставлен список из 42 стран. В столбце D мне указана цена Биг Мака в этой стране в долларах США. Строка 1 имеет заголовки, поэтому данные начинаются со строки 2. Мне нужно создать макрос, который позволяет пользователю вводить 2 страны (Country1 и Country2), будет перебирать столбец A, чтобы найти страны, которые ввел пользователь, и соответствующие им цены. Он должен сохранить местоположение ячейки страны в некоторой переменной, а цену — просто в виде числа. Если цена в стране 1 больше, чем в стране 2, название страны 1 должно иметь зеленый цвет шрифта, а Страна 2 — красный. И наоборот.
Прямо сейчас выполняется весь код. Но цвета ячеек не меняются.
На случай, если вы хотите это протестировать, вот верхняя часть листа:
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
Ответ №1:
Проблема в том, что у вас нет Set TheCell
внутри вашего Do
цикла, поэтому он никогда не меняется с 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" amp; Columns("A:A").Find(What:=Country1).Row)
Set Price2Cell = Range("A" amp; Columns("A:A").Find(What:=Country2).Row)
Price1 = Range("A" amp; Columns("A:A").Find(What:=Country1).Row).Offset(0, 3).Value
Price2 = Range("A" amp; 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