如何在单个宏子函数中使用多个循环

时间:2013-05-15 20:01:33

标签: excel excel-vba vba

我使用以下代码删除Excel工作表中的行。我使用了两个不同的循环(第一个是For循环,第二个是Do-While循环)。

当我运行宏时,它只执行第一个循环(for循环),只删除第4,5和4行。 6并且不执行第二个循环(Do-While循环)。但如果我第二次运行它然后执行第二个循环(Do-While)并删除行9,10,11,12,13。

我试图让解决方案在一次运行宏中运行两个循环,但无法得到它。请让我在单次运行宏中运行两个循环。

Row No    A
1 
2       Block1
3       
4       del1
5       del2
6       del3
7
8       Block2
9       del1
10      del2
11      del3
12      del5
13      del5

使用的代码:

Sub RowDelete()
    Dim a
    Dim b
    Dim strt
    Dim endr

    strt = getrow("Blobk1")
    endr = getrow("Block2")


    For a = endr - 2 To strt + 3 Step -1
        Worksheets("s1").Cells(a, 1).EntireRow.Delete Shift:=xlUp
    Next

    b = endr + 2
    Do While Worksheets("s1").Cells(b, 1).Value <> ""
        Worksheets("s1").Cells(b, 1).EntireRow.Delete Shift:=xlUp
    Loop
End Sub

Function Getrow(str)
    Dim a
    Dim b
    For a = 1 To 50
        If Worksheets("s1").Cells(a, 1).Value = str Then
            b = a
            Exit For
        End If
    Next
    getrow = b
End Function

2 个答案:

答案 0 :(得分:1)

问题是,endr变量中获得的行在到达Do ... While循环时不再存在。

这是因为上一个循环中的删除操作已经改变了工作表的结构,因此“Block 2”不再位于endr变量所持有的行号中。

您可以根据需要在循环之间重置此值。

此外,使用Application.Match函数代替该自定义函数来获取行号。

Sub RowDelete()
'## Dimension your variables properly ##'
Dim a As Long
Dim b As Long
Dim strt As Long
Dim endr As Long

'## Add some new variables ##'
Dim ws As Worksheet
Dim rangeLook As Range


Set ws = Worksheets("s1")

'## this is the range you will look for your blocks ##'
Set rangeLook = ws.Range("A1:A50")

'## USE THE MATCH FUNCTION INSTEAD OF CUSTOM FUNCTION TO GET ROW NUMBER ##
strt = Application.Match("Block1", rangeLook, False)
endr = Application.Match("Block2", rangeLook, False)


For a = endr - 2 To strt + 2 Step -1
    ws.Cells(a, 1).EntireRow.Delete
Next

'## RESET THIS VARIABLE SINCE THE ROW HAS CHANGED ##'
endr = Application.Match("Block2", rangeLook, False)

b = endr + 1

Do While Worksheets("s1").Cells(b, 1).Value <> ""
    ws.Cells(b, 1).EntireRow.Delete
Loop

End Sub

答案 1 :(得分:0)

我认为使用单循环的简单方法如下:

Sub DeleteRows()
Dim rw As Long
    For rw = Range("A1048576").End(xlUp).Row To 2 Step -1
        If Cells(rw, 1) <> vbNullString And Cells(rw, 1) <> "Block1" And Cells(rw, 1) <> "Block2" Then
            Cells(rw, 1).EntireRow.Delete Shift:=xlUp
        End If
    Next rw
End Sub

更简单的是,如果您要删除A列中的所有内容,只需离开Block1Block2即可使用:

Sub CleanUpColumn() 
    Columns("A:A").ClearContents
    Range("A2") = "Block1"
    Range("A4") = "Block2"
End Sub