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

时间:2019-11-14 00:02:58

标签: arrays excel vba

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

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

enter image description here

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

1 个答案:

答案 0 :(得分: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

在这种情况下,我没有使用数组来遍历每个单元格

注意:如果可行,请记住标记答案以帮助他人