循环无法正确删除工作表中的行

时间:2018-08-14 11:51:42

标签: excel vba excel-vba

这是我必须要做的任务。

我有一个工作表,用户可以在其中指定列名和该列下的元素,一旦选择,宏将查找并删除具有该名称的每个元素。

我的问题来自宏的最后一部分,即删除。我的循环不会删除所有行,它只会找到该元素的一个实例并将其删除,然后转到下一个元素并将其删除,而所有其他具有相同名称的元素将保持不变。

这是宏中的函数,由于我对vba不太了解,因此我对代码质量不好表示歉意。

Function LineDelete() As Variant
Dim NbLignes As Integer
Dim ctr As Integer
Dim ctr2 As Integer
Dim Table As Variant

Worksheets("parametrage_suppr_ligne").Activate

ctr = 1
ctr2 = 1
NbLignes = Cells.Find("*", Range("A1"), , , xlByRows, xlPrevious).Row - 4
ReDim Table(1 To NbLignes, 2)


While ctr <= NbLignes
   Table(ctr, 1) = Cells(ctr + 4, 1).Value
   Table(ctr2, 2) = Cells(ctr2 + 4, 2).Value
   ctr = ctr + 1
   ctr2 = ctr2 + 1
Wend

Call FileOpen
Call delInvalidChars
Call OrderRows

Dim newCtr As Integer
Dim rng As Range
Dim rngHeaders As Range
Dim newString As Variant
Dim i As Integer

NbLignes = 0
NbLignes = Cells.Find("*", Range("A1"), , , xlByRows, xlPrevious).Row
Set rngHeaders = Range("1:1")
newCtr = 1

For i = NbLignes To FirstRow Step -1
    Set rng = rngHeaders.Find(Table(newCtr, 1))
    If Table(newCtr, 1) = rng Then
        MsgBox "All is gud!!"
        newString = Cells.Find(Table(newCtr, 2))
        If Table(newCtr, 2) = newString Then
            MsgBox newString
            Range(Cells.Find(Table(newCtr, 2)).Address).EntireRow.Delete
            newCtr= newCtr + 1
        End If
    End If
    newCtr = newCtr + 1
Next i
End Function

现在,请解释一下我在这里所做的事情。 首先,我使用一个简单的循环将选项存储在2维表中,在该表中,我将列的名称以及必须删除的列下的元素的名称存储在该表中。

之后,我调用打开txt文件的函数,然后将其转换为excel文件,必须在此新的excel文件中进行删除。

然后我重置NbLignes变量并调用新变量。

这里是问题开始的地方,我认为通过迭代新excel文件的行数,可以解决问题。该程序将在该列中查找该单词的所有实例,并打算将其删除,但到目前为止,它只会执行3次。

我完全不知道要进行哪些修改才能解决此问题。

这是配置表的外观,这是用户可以修改以指定要删除的内容,这也是我存储在2d表中的内容: 用户可以根据需要添加任意多的列和名称
User can add as many columns and names as needed

编辑:更新后的代码现在执行的操作是删除与图像中第一个名称相同的所有元素(fun_h_opcomp),预期结果是,一旦删除所有这些元素,然后该程序应传递到下一个(fun_b_pterm),依此类推。

1 个答案:

答案 0 :(得分:0)

当然i只是该计数器的一个示例,您必须在此处使用newCtr计数器,并且FirstRow必须设置为一个值。

Const FirstRow As Long = 1
Dim newCtr As Long 'always use Long for row counting
For newCtr = NbLignes To FirstRow Step -1
    Set rng = rngHeaders.Find(Table(newCtr, 1))
    If Table(newCtr, 1) = rng Then
        MsgBox "All is gud!!"
        newString = Cells.Find(Table(newCtr, 2))
        If Table(newCtr, 2) = newString Then
            MsgBox newString
            Range(Cells.Find(Table(newCtr, 2)).Address).EntireRow.Delete
        End If
    End If
Next newCtr

因为newCtr语句自动完成了操作,所以不再需要增加Next