arrays - 按列循环遍历单元格的最有效方法

Question

我需要按列循环遍历工作表的每个单元格。我想，将范围转换为数组可能是最明智的选择，因为我需要遍历 68 列中的 5000 行。

我需要用设定值替换超过 5000 行（在不同位置）的零。下图是我的表格的样子，需要用相应行的平均值替换零

Sub searchreplace()    
    Dim wb As Workbook
    Set wb = ThisWorkbook

    Dim i As Long
    Dim j As Long
    Dim lr As Long
    Dim col As Long
    Dim rng() As Variant
    Dim ws As Worksheet
    Dim arr As Variant

    Set ws = wb.Worksheets(1)

    'lr = last row with data
    Set ws = ActiveSheet

    With ActiveSheet
        lr = Range("C" & Rows.Count).End(xlUp).Row

        ' last column number MO66
        col = Range("BP1").Column

        'clumn with avg values
        colavg = Range("BQ1").Column

        'Debug.Print colavg

        'Define range
        'cells(row,col)!    

        'my range stored as an array
        rng = Range(Cells(3, 3), Cells(3, col + 6)). Value

        'looping through each value of the array
        For i = 1 To 70 '70 columns
            If rng(1, i) = 0 Then
                rng(1, i) = 5.34

            End If  
        Next i    
    End With
End Sub

标签： arraysexcelvba

Answer 1

假设查找值 (0) 每行仅出现一次

尝试此代码并阅读注释以调整它以满足您的需求

Public Sub ReplaceValueWithRowAverage()

    Dim evalRange As Range
    Dim evalCell As Range
    Dim targetCell As Range

    Dim targetValue As Double ' Adjust type to fit your needs
    Dim averageValue As Double ' Adjust type to fit your needs
    Dim evalSheetName As String
    Dim evalRangeAddress As String

    targetValue = 0
    evalSheetName = "Sheet1"
    evalRangeAddress = "A5:BP5232" ' This could be UsedRange with SpecialCells if sheet contains the target range

    Application.ScreenUpdating = False

    ' Set the range to be evaluated
    Set evalRange = ThisWorkbook.Worksheets(evalSheetName).Range(evalRangeAddress)

    ' Loop through each row
    For Each evalCell In evalRange.Columns(1).Cells

        ' Get the average value
        averageValue = evalCell.Offset(0, evalRange.Columns.Count - 1).Value2

        ' Find the target cell with value in row
        Set targetCell = evalCell.Resize(1, evalRange.Columns.Count - 1).Find(targetValue, LookIn:=xlFormulas, LookAt:=xlWhole)

        ' Replace the value with row average
        If Not targetCell Is Nothing Then targetCell.Value2 = averageValue

    Next evalCell

    Application.ScreenUpdating = True

    MsgBox "Finished"

End Sub

编辑：

要替换所有出现，您可以使用 Range.Replace 方法

Public Sub ReplaceValueWithRowAverage()

    Dim evalRange As Range
    Dim evalCell As Range
    Dim targetCell As Range

    Dim targetValue As Double ' Adjust type to fit your needs
    Dim averageValue As Double ' Adjust type to fit your needs
    Dim evalSheetName As String
    Dim evalRangeAddress As String

    targetValue = 0
    evalSheetName = "Sheet1"
    evalRangeAddress = "A5:BP5232" ' This could be UsedRange with SpecialCells if sheet contains the target range

    Application.ScreenUpdating = False

    ' Set the range to be evaluated
    Set evalRange = ThisWorkbook.Worksheets(evalSheetName).Range(evalRangeAddress)

    ' Loop through each row
    For Each evalCell In evalRange.Columns(1).Cells

        ' Get the average value
        averageValue = evalCell.Offset(0, evalRange.Columns.Count - 1).Value2

        ' Replace all ocurrences in row
        evalCell.Resize(1, evalRange.Columns.Count - 1).Cells.Replace What:=targetValue, Replacement:=averageValue, _
                          LookAt:=xlWhole, SearchOrder:=xlByRows, MatchCase:=False, _
                          SearchFormat:=False, ReplaceFormat:=False


    Next evalCell

    Application.ScreenUpdating = True

    MsgBox "Finished"

End Sub

在这种情况下，我没有使用数组作为循环遍历每个单元格的速度非常快

注意：如果有效，记得标记答案以帮助他人