单元格范围以供以后格式化

Question

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

在A列中，我列出了42个国家/地区。在D栏中，给出了该国巨无霸的价格（美元）。第1行有标题，因此数据从第2行开始。我需要构建一个宏，该宏允许用户输入2个国家（Country1和Country2），将在A列中循环查找用户输入的国家及其对应的国家价格。它应将国家/地区的单元格位置保存为一些变量，并将价格保存为一个数字。如果Country1的价格大于国家2的价格，则Country1的名称应具有绿色的字体颜色，而Country2的名称应具有红色的字体颜色。反之亦然。

现在，我得到的错误是变量TheCell的“对象变量或未设置块变量”。

如果要对其进行测试，这是表格的顶部：

我尝试将TheCell调暗。我尝试过使其变种，但这是行不通的。我很确定Range是正确的，因为它是实际的单元格。

d <- structure(list(x = c(1L, 1L, 1L, 1L, 2L, 2L, 2L, 2L,
                          3L, 3L, 3L, 3L, 4L, 4L, 4L, 4L),
                    y = c(1L, 2L, 3L, 4L, 1L, 2L, 3L, 4L,
                          1L, 2L, 3L, 4L, 1L, 2L, 3L, 4L),
                    sig = c(FALSE, FALSE, FALSE, TRUE, FALSE, FALSE, TRUE, TRUE,
                            TRUE, FALSE, FALSE, FALSE, TRUE, FALSE, FALSE, TRUE),
                    z = c(0.96, 0.76, 0.14, 0.93, 0.39, 0.06, 0.99, 0.77,
                          0.7, 0.72, 0.08, 0.94, 0.98,  0.83, 0.12, 0.42)),
               row.names = c(NA, -16L), class = "data.frame")

Answer 1

除了对象初始化外，您的代码是有序的并且基本正确。在处理对象时，必须使用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 2

您可以尝试以下操作：

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

保存特定单元格的地址以便以后更改

3 个答案:

单元格范围以供以后格式化