Range中的列值（数学）

Option Explicit

Sub PopulateColumn() ' this is also bad; make it more descriptive (personalized)
    
    ' Reference the worksheet.
    Dim ws As Worksheet: Set ws = ActiveSheet ' improve!
    ' If it's in the workbook containing this code and you know its name,
    ' then reference it explicitly instead, e.g.:
    'Set ws = ThisWorkbook.Worksheets("Sheet1")
    
    ' Reference the source one-column range.
    Dim srg As Range
    Set srg = ws.Range("I2", ws.Cells(ws.Rows.Count, "I").End(xlUp))
    
    ' Reference the destination one-column range.
    Dim drg As Range: Set drg = srg.EntireRow.Columns("G")
    
    Dim sCell As Range
    Dim sCellValue As Variant
    Dim r As Long
    Dim dCell As Range
    Dim dResult As Double
    
    ' Reference each source cell...
    For Each sCell In srg.Cells
        ' ... and store its value.
        sCellValue = sCell.Value
        ' Increase the row index by 1...
        r = r + 1
        ' ... to reference the destination cell.
        Set dCell = drg.Cells(r)
        ' Check if the source value is a number.
        If VarType(sCellValue) = vbDouble Then ' is a number
            ' Determine the destination result.
            Select Case sCellValue
                Case Is < 100000: dResult = 300
                Case Is < 1000000: dResult = 200
                Case Is < 3000000: dResult = 100
                Case Else: dResult = 75
            End Select
            ' Write the result to the destination cell.
            dCell.Value = dResult
        Else ' is not a number
            ' Clear the contents of the destination cell.
            dCell.ClearContents
        End If
    Next sCell
        
    ' Inform.
    MsgBox "Column populated.", vbInformation
        
End Sub

1. Cell是Excel中的保留字。不能将保留字用作变量名。
   1.案例是有序的，如果你已经确定某个东西小于一个数字，你不需要再说一遍。
2. Select Case有一个To，可用于覆盖一个数字范围
   使用这些主体，您的代码看起来像这样：

Option Explicit

Public Sub comparison()

    Dim thisCell As Range
    For Each thisCell In Range("I2", Range("I2").End(xlDown))
        Select Case thisCell.Value
        Case Is > 3000000
            thisCell.Offset(, -2).Value = 75
        Case 3000000 To 1000000
            thisCell.Offset(, -2).Value = 100
        Case 1000000 To 100000
            thisCell.Offset(, -2).Value = 200
        Case Is < 100000
            thisCell.Offset(, -2).Value = 300
        End Select
    Next thisCell
        
End Sub