如何將公式應用于列vba范圍中的每個單元格？

例如，我有一個包含一列數字的 excel 檔案（有時會有一些文本或空白單元格）

4
5
10
13
5

4
not applicable

9
2
1
6

我想將一個函式應用于執行以下操作的那個單元格。如果單元格值為空白或文本不執行任何操作。如果該值小于 8，則將其設為 8，如果大于或等于 8，則不執行任何操作。所以我的示例列將變為：

8
8
10
13
8

8
not applicable

9
8
8
8

我希望用新值覆寫單元格中的值，而不是保留單元格中的原始值。

當然，我可以這樣做=max(cell, 8)，然后將輸出復制到列的下方，并將復制/粘貼值復制到列的頂部，但我需要為一張紙上的多個列（100 次）執行此操作，所以我需要一個好方法做這個。

到目前為止，我已經設法撰寫了一個宏來遍歷我的作業表并選擇我需要更新的列，但我不知道如何實際更新它們。

我可以定義一個函式，然后將其應用于列中的每個單元格嗎？有沒有更快/更有效的方法來做到這一點。

編輯

到目前為止的代碼：

Sub updatemin()

Dim i, updatecol As Integer
updatecol = 14


For i = 1 To 100
    Columns(updatecol).Select
    'need to figure out how to make any values less than 8 into 8 for the cells in the given range before moving on to the next column to do the same.
    updatecol = updatecol   22
Next i

End Sub

uj5u.com熱心網友回復：

更新列

Option Explicit

Sub UpdateMin()

    Const FirstCellAddress As String = "N2"
    Const ColumnOffset As Long = 22
    Const ColumnsCount As Long = 100
    Const MinCriteria As Double = 8
    
    Dim ws As Worksheet: Set ws = ActiveSheet ' improve!
    
    Dim fCell As Range: Set fCell = ws.Range(FirstCellAddress)
    
    Dim rg As Range
    Dim lCell As Range
    Dim rCount As Long
    
    With fCell.Resize(ws.Rows.Count - fCell.Row   1, _
            (ColumnsCount - 1) * ColumnOffset   1)
        Set lCell = .Find("*", , xlFormulas, , , xlPrevious)
        If lCell Is Nothing Then Exit Sub
        rCount = lCell.Row - .Row   1
        Set rg = .Resize(rCount, 1)
    End With
    
    Dim Data As Variant
    Dim cValue As Variant
    Dim r As Long
    Dim c As Long
    
    For c = 1 To ColumnsCount
        With rg.Offset(, (c - 1) * ColumnOffset)
            'Debug.Print .Address
            Data = .Value
            For r = 1 To rCount
                cValue = Data(r, 1)
                If VarType(Data(r, 1)) = vbDouble Then
                    If cValue < MinCriteria Then
                        Data(r, 1) = MinCriteria
                    End If
                End If
            Next r
            .Value = Data
            '.Interior.Color = vbYellow
        End With
    Next c
    
    MsgBox "Columns updated.", vbInformation

End Sub

uj5u.com熱心網友回復：

我建議將資料的獲取和處理分開。至于后者，為什么不對=IF(Data < Minimum, Minimum, Data)資料范圍內的數字應用公式呢？要僅選擇數字，我們可以使用SpecialCells.

Sub UpdateMin(Data As Range, Optional MinCriteria As Double)
Dim Numbers As Range
Dim Area As Range
Dim Formula As String
    On Error Resume Next
    Set Numbers = Data.SpecialCells(xlCellTypeConstants, xlNumbers)
    If Numbers Is Nothing Then Exit Sub
    On Error GoTo 0
    For Each Area In Numbers.Areas
        ' =IF(Area < MinCriteria, MinCriteria, Area)
        Formula = "IF(" & Area.Address & "<" & MinCriteria & "," & MinCriteria & "," & Area.Address & ")"
        Area.Value2 = Evaluate(Formula)
    Next Area
End Sub

我們需要在這里迭代連續區域以計算IF(...)為陣列公式。為了獲得對您的案例感興趣的范圍，我將使用以下代碼：

Function getData() As Range
Dim Result As Range
Const DataSheet = "Sheet1"
Const first = 14
Const delta = 22
Const last = first   99 * delta
Dim i&
    ' rebuild to your needs
    With ThisWorkbook.Worksheets(DataSheet)
        Set Result = .Columns(first)
        For i = first   delta To last Step delta
            Set Result = Union(Result, .Columns(i))
        Next i
        Set getData = Intersect(Result, .UsedRange)
    End With
End Function
 

最后一部分：

Sub main_macro()
    UpdateMin getData, 8
End Sub

我不確定這是否是一個好方法，因為我們對資料進行了兩次迭代——選擇數字然后更新它們。但這兩個部分都針對 Excel 本身。所以，我希望，至少在有大量數字的情況下，這項作業會很快完成。我認為最糟糕的情況是數字和單詞的定期交替。讓我知道你的選擇以及它最終是如何運作的。

uj5u.com熱心網友回復：

想象一下A列中的以下資料

使用以下代碼回圈遍歷所有資料，如果小于 8 則將其變為 8，如果單元格不是數字或為空，則省略單元格。

Option Explicit

Public Sub Example()
    Dim ws As Worksheet  ' define your worksheet
    Set ws = ThisWorkbook.Worksheets("Sheet1")

    Dim LastRow As Long  ' find last used row in column A
    LastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row

    ' update data to MinValue in the given DataRange
    UpdateValuesToMinimum MinValue:=8, DataRange:=ws.Range("A1", "A" & LastRow)
End Sub


Public Sub UpdateValuesToMinimum(ByVal MinValue As Long, ByVal DataRange As Range)
    Dim DataValues() As Variant  ' read all data into an array for faster processing
    DataValues = DataRange.Value2
    
    Dim iRow As Long  ' loop through all rows
    For iRow = LBound(DataValues, 1) To UBound(DataValues, 1)
        Dim iCol As Long  ' loop through all columns
        For iCol = LBound(DataValues, 2) To UBound(DataValues, 2)
            ' check if it is numeric and not empty
            If IsNumeric(DataValues(iRow, iCol)) And DataValues(iRow, iCol) <> vbNullString Then
                ' if data is <MinValue set it to MinValue 
                If DataValues(iRow, iCol) < MinValue Then
                    DataValues(iRow, iCol) = MinValue
                End If
            End If
        Next iCol
    Next iRow
    
    ' write array data back to the cells
    DataRange.Value2 = DataValues
End Sub

你會得到結果：

標籤：擅长 vba

上一篇：如何在VBA中創建帶有復選框欄位的MSAccess表

下一篇：使用IP地址連接資料庫