Сохранение адреса определенных ячеек, чтобы изменить их позже

Question

Я использую Excel VBA, чтобы попытаться решить следующую проблему:

В столбце А мне дан список из 42 стран. В столбце D мне дана цена на Биг Мак в этой стране в долларах США. Строка 1 имеет заголовки, поэтому данные начинаются со строки 2. Мне нужно создать макрос, который позволит пользователю вводить 2 страны (Страна1 и Страна2), циклически перебирает столбец А, чтобы найти страны, в которых он находится, и соответствующие им Цены. Это должно сохранить местоположение ячейки страны в какую-то переменную, а цену - просто число. Если цена Country1 больше, чем у страны 2, название Country1 должно иметь цвет шрифта зеленый, а Country2 цвет шрифта красный. И наоборот.

В настоящий момент я получаю сообщение об ошибке «Переменная объекта или переменная блока не установлена» для моей переменной TheCell.

Если вы хотите проверить это, вот верхняя часть листа:

Я пытался поиграть с тем, что я затемнил TheCell. Я пытался сделать это вариант, но это не сработало. Я почти уверен, что Range правильный, потому что это фактическая ячейка.

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
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. 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.)

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

    If 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. If Country1's price is greater than Country2's Price, then Country1 should be colored red and Country2 green. And vice-versa.

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

Answer 1

Вы можете попробовать следующее:

Option Explicit

Sub test()

    Dim Country1 As String, Country2 As String
    Dim LastRow As Long
    Dim Position1 As Range, Position2 As Range
    Dim Price1 As Double, Price2 As Double

        Country1 = "Italy" '<- Testing name
        Country2 = "Cyprus" '<- Testing name
      With ThisWorkbook.Worksheets("Sheet1") '<- Change to fit your needs

        LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row

        Set Position1 = .Range("A2:A" & LastRow).Find(Country1)

            If Not Position1 Is Nothing Then
                MsgBox "Country appears in: " & vbNewLine & "Column:" & Position1.Column & vbNewLine & "Row:" & Position1.Row & vbNewLine & "Full Address:" & Position1.Address & vbNewLine & "Price:" & .Range("D" & Position1.Row).Value
                Price1 = .Range("D" & Position1.Row).Value
            Else
                MsgBox "Country & Price1 not found."

            End If

        Set Position2 = .Range("A2:A" & LastRow).Find(Country2)

            If Not Position2 Is Nothing Then
                MsgBox "Country appears in: " & vbNewLine & "Column:" & Position2.Column & vbNewLine & "Row:" & Position2.Row & vbNewLine & "Full Address:" & Position2.Address & vbNewLine & "Price:" & .Range("D" & Position2.Row).Value
                Price2 = .Range("D" & Position2.Row).Value
            Else
                MsgBox "Country not & Price2 found."
            End If

            If Not Position1 Is Nothing And Not Position2 Is Nothing Then
                If Price1 > Price2 Then
                    .Range("D" & Position1.Row).Font.Color = vbRed
                    .Range("D" & Position2.Row).Font.Color = vbGreen
                End If

                If Price2 > Price1 Then
                    .Range("D" & Position1.Row).Font.Color = vbGreen
                    .Range("D" & Position2.Row).Font.Color = vbRed
                End If
            End If

    End With

End Sub

Answer 2

Ваш код упорядочен и практически корректен, за исключением инициализации объекта. Когда вы имеете дело с объектами , вы должны использовать Set для их инициализации, например:

Set TheCell = Cells(Counter, 1)

Таким образом, окончательный рабочий код должен выглядеть следующим образом:

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. 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.)

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

        If 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. If Country1's price is greater than Country2's Price, then Country1 should be colored red and Country2 green. And vice-versa.

    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

Я сделал несколько тестов, и это работает.

Answer 3

Диапазон ячеек для последующего форматирования

Option Explicit

Sub CountryComparison()

    Const cCountry As Variant = "A"   ' Country Column Letter/Number
    Const cPrice As Variant = "D"     ' Price Column Letter/Number
    Const cFR As Long = 2             ' First Row Number
    Const cLR As Long = 42            ' Last Row Number

    Dim Country1 As String    ' 1st Country
    Dim Country2 As String    ' 2nd Country
    Dim TheCell As Range      ' Current Cell Range
    Dim Price1Cell As Range   ' 1st Price Cell Range
    Dim Price2Cell As Range   ' 2nd Price Cell Range
    Dim Price1 As Double      ' 1st Price
    Dim Price2 As Double      ' 2nd Price
    Dim i As Long             ' Row Counter

    ' The user inputs what countries they want to compare.
    Country1 = InputBox("Enter Country 1")
    Country2 = InputBox("Enter Country 2")

    ' 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. 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.)

    ' The Last Row (LR) is usually calculated from the bottom like this:
    'LR = Cells(Rows.Count, cCountry).End(xlUp).Row
    ' If you want to adopt this, just change cLR to LR in the first lines
    ' of the For Next loops and delete cLR in the constants section and
    ' add the declaration: Dim LR as Long

    ' Loop through cells (rows) of Country Column.
    For i = cFR To cLR
        ' Create a reference to Current Cell in Country Column.
        Set TheCell = Cells(i, cCountry)
        ' Check value of Current Cell against 1st Country.
        If TheCell.Value = Country1 Then
            ' Create a reference to 1st Price Cell Range from Current Cell.
            Set Price1Cell = TheCell
            ' Write the value of the cell at the intersection of current row
            ' and Price Column to 1st Price.
            Price1 = Cells(TheCell.Row, cPrice).Value
            ' A match was found so stop looping.
            Exit For
        End If
    Next

    ' Loop through cells (rows) of Country Column.
    For i = cFR To cLR
        ' Create a reference to Current Cell in Country Column.
        Set TheCell = Cells(i, cCountry)
        ' Check value of Current Cell against 2nd Country.
        If TheCell = Country2 Then
            ' Create a reference to 2nd Price Cell Range from Current Cell.
            Set Price2Cell = TheCell
            ' Write the value of the cell at the intersection of current row
            ' and Price Column to 2nd Price.
            Price2 = Cells(TheCell.Row, cPrice).Value
            ' A match was found so stop looping.
            Exit For
        End If
    Next

    ' Here's the final point. If Country1's price is greater than Country2's
    ' Price, then Country1 should be colored red and Country2 green.
    ' And vice-versa.

    ' Compare Prices
    Select Case Price1
        Case Is > Price2
            Price1Cell.Font.Color = vbRed
            Price2Cell.Font.Color = vbGreen
        Case Is < Price2
            Price1Cell.Font.Color = vbGreen
            Price2Cell.Font.Color = vbRed
    End Select

End Sub