查找包含连续零的列中的范围并检索行号

时间:2017-06-26 17:51:23

标签: excel vba excel-vba range

我试图在VBA中写一个在A列中搜索零的宏,将它与同一行但在B列中的单元格进行比较,如果两者都为零,则在下一行中两列都为零好吧,宏显示它找到第一个零的第一行和最后一个零所在的最后一行。

我目前正在用For For循环编写它,在A列中搜索并与B列进行比较,但我不知道如何制作它以便继续搜索直到列结束。我必须注意,可能有多个连续零的范围,因此我想我需要一个存储范围的数组,或者至少是行数。

   Sub BuscaMargenCero()
'
'

'
    Dim ini() As Variant
    Dim fin() As Variant
    Dim UltimaFila As Long
    Dim cell As Range
    Dim i As Integer
    Dim j As Integer
    Dim flag As Integer

    With Sheets("CÁLCULO Margen")
        UltimaFila = .Range("B" & .Rows.Count).End(xlUp).Row - 1

        i = 1
        j = 1
        flag = 0
        For Each cell In Range("B2:B" & UltimaFila)
            If cell = 0 And .Cells(cell.Row + 1, 6).Value = 0 Then
                If flag = 0 And (.Cells(cell.Row + 1, 2).Value = 0 And .Cells(cell.Row + 1, 6).Value = 0) Then
                    ini(i) = cell.Row
                    i = i + 1
                    flag = 1
                ElseIf flag = 1 And (.Cells(cell.Row + 1, 2).Value <> 0 Or .Cells(cell.Row + 1, 6).Value <> 0) Then
                    fin(j) = cell.Row
                    j = j + 1
                    flag = 0
                End If
            End If
        Next

    End With
End Sub

我没有使用Range.Find,因为我读过它只检索找到的第一个值,我希望它继续搜索更多的零。

编辑:澄清我的问题,这是应用程序应该如何工作

A     B

2     5
0     1
0     0
0     0
0     0
12    20

输出数组应包含范围(行号)3 - 5

1 个答案:

答案 0 :(得分:1)

。对每列的零点进行自动调整。第一个,最后一个或每个&#39;设置&#39;将成为SpecialCells(xlcelltypevisible)中每个.Area的第一个和最后一个。

.AutoFilter需要标题行。

// saves file to system
function handleProfilePictureUpload(req, res, next) {
  upload(req, res, function(err) {
    if (err) req["file"] = false;
    if (!req["file"]) req["file"] = false;
    next();
  })
}

模块代码:

col A   col B
    2    5
    0    1
    0    0
    0    0
    0    0
   12   20
    0    0
    0    0
   12   20

立即窗口结果:

Sub Macro2()
    Dim a As Long, rws As Variant

    With Worksheets("sheet4")
        if .autofiltermode then .autofiltermode = false
        With .Range(.Cells(1, "A"), .Cells(.Rows.Count, "B").End(xlUp))
            .AutoFilter field:=1, Criteria1:=0
            .AutoFilter field:=2, Criteria1:=0
            With .Resize(.Rows.Count - 1, .Columns.Count).Offset(1, 0)
                If CBool(Application.Subtotal(103, .Cells)) Then
                    With .SpecialCells(xlCellTypeVisible)
                        ReDim rws(1 To .Areas.Count, 1 To 2)
                        For a = LBound(rws, 1) To UBound(rws, 1)
                            With .Areas(a)
                                rws(a, 1) = .Cells(1).Row
                                rws(a, 2) = .Cells(.Cells.Count).Row
                            End With
                        Next a
                    End With
                End If
            End With
        End With
        if .autofiltermode then .autofiltermode = false
    End With

    For a = LBound(rws) To UBound(rws)
        Debug.Print rws(a, 1) & " to " & rws(a, 2)
    Next a
End Sub
相关问题