在一个范围内循环,逐行循环

时间:2016-09-14 10:15:42

标签: vba excel-vba excel

我有一些看起来像这样的数据:

enter image description here

对于标有"优惠券"的所有行我想为该行中的条目添加一个数字,如果它们是非空白的。如果他们是空白的,我想让他们独自一人。此外,如果单元格中的数据恰好是日期,我也不想触摸它。

逐行我想要在整个范围内运行。

我当前的代码给了我一个"因为每个代码只能迭代一个集合对象或一个数组vba"错误。请帮忙!

Sub CommandButton1_Click()


Dim rng As Range
Dim rw As Range
Dim cel As Range


Set rng = Range("E15:P464")

For Each rw In rng.Row
    If rw.Item(1, 1) = "coupon" Then
      For Each cel In rw.Cells
            If IsEmpty(cel.Value) = False Then
                   If Not IsDate(cel) Then
                       cel.Value = cel.Value + 0.0001
                   End If
            End If
      Next cel
    End If
Next rw



End Sub

2 个答案:

答案 0 :(得分:1)

尝试下面的代码,它与您发布的代码略有不同:

Sub CommandButton1_Click()

Dim rng         As Range
Dim rw          As Range
Dim Col         As Long
Dim CellStr     As String

Set rng = Range("E15:P464")

' loop through rows in Range
For Each rw In rng.Rows
    ' get the value of the first column and convert to String
    CellStr = rw.Columns(1).Value

    ' use StrComp to verify match between strings
    If StrComp(CellStr, "coupun") = 0 Then

        ' loop through all columns in current row (where there was a match with "coupun"
        For Col = rng.Columns(2).Column To rw.Columns.Count

            ' check if current cell is empty
            If Not IsEmpty(Cells(rw.Row, Col)) Then
                If Not IsDate(Cells(rw.Row, Col)) Then
                    Cells(rw.Row, Col).Value = Cells(rw.Row, Col).Value + 0.0001
                End If
            End If
        Next Col

    End If
Next rw

End Sub

答案 1 :(得分:1)

chris neilsen提供了修复错误的解决方案

您可能希望采用其他AutoFilter()方法,如下所示:

Option Explicit

Sub main()
    Dim cel As Range

    With Worksheets("Coupons") '<--| reference "Coupons" worksheet (change "Coupons" to your actual worksheet name)
        With .Range("A1").CurrentRegion '<--| reference its range made of cells contiguous to "A1"
            .AutoFilter Field:=1, Criteria1:="Coupon" '<--| filter it on column "A" with "Coupon" criteria
            If Application.WorksheetFunction.Subtotal(103, .Resize(, 1)) > 1 Then '<--| if any "Coupon" in column A" has been filtered
                For Each cel In .Offset(1, 1).Resize(.rows.Count - 1, .Columns.Count - 1).SpecialCells(xlCellTypeVisible).SpecialCells(XlCellType.xlCellTypeConstants, xlNumbers) '<-- loop through filtered range cells containing numbers (and skipping column "A" and row 1)
                    If Not IsDate(cel) Then cel.Value = cel.Value + 0.0001 ' update non-date numbers
                Next cel
            End If
        End With
        .AutoFilterMode = False '<--| show all rows back
    End With
End Sub