在VBA的子例程中创建包含特定值的字符串后删除行?

时间:2017-05-04 09:58:48

标签: excel vba excel-vba

我想调用子例程来从我的列colCell中删除包含单元格中某个值的行。所以我们创建一个包含''的字符串,如果它无法识别另一个工作表上的任何值来创建字符串。

aCell.Value = Replace(aCell.Value, Split(aCell.Value, ",")(1), "'" & Sheet5.Cells(colCell.Row, 2) & "'")
DeleteRows (colCell)

我以为我可以调用上面的子程序并传入列变量?

主要子程序:

Sub Main()

Set wDFS = ThisWorkbook.Sheets("Data")
Set colCell = wDFS.Rows("1:1").Find(what:="New query", after:=wDFS.Cells(1, 1), LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext)

If Not colCell Is Nothing Then
Set rng = wDFS.Range(wDFS.Cells(2, colCell.Column), wDFS.Cells(wDFS.UsedRange.Rows.Count, colCell.Column))
For Each aCell In rng
    Set colCell = Sheet5.Range("A1:A" & Sheet5.UsedRange.Rows.Count).Find(what:=Replace(Split(aCell.Value, ",")(1), "'", ""), after:=wDFS.Cells(1, 1), LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext)
    If Not colCell Is Nothing Then
        aCell.Value = Replace(aCell.Value, Split(aCell.Value, ",")(1), "'" & Sheet5.Cells(colCell.Row, 2) & "'")
        DeleteRows (colCell)
    Else
        With Sheet5.Range("A" & Sheet5.Range("A" & Rows.Count).End(xlUp).Row + 1)
            .Value = Replace(Split(aCell.Value, ",")(1), "'", "")
            .Interior.Color = 255
        End With
    End If
Next aCell
Else
MsgBox "No new query column found in " & wDFS.Name & " sheet"
End If

End Sub

删除行的子例程:

Sub DeleteRows(colCell)
Dim c As Range
Dim SrchRng

Set SrchRng = ActiveSheet.Range("Data", ActiveSheet.Range(colCell).End(xlUp))
Do
    Set c = SrchRng.Find("''", LookIn:=xlValues)
    If Not c Is Nothing Then c.EntireRow.Delete
Loop While Not c Is Nothing
End Sub

在调试中,它表示以下行存在问题:

Set SrchRng = ActiveSheet.Range("DataFeedSheet", ActiveSheet.Range(colCell).End(xlUp))

我认为它与我指定的范围有关。

你是怎么做到的?

提前致谢!

1 个答案:

答案 0 :(得分:0)

Sub DeleteRow4()

Dim rng As Range, cell_search As Range, del As Range
Set rng = Intersect(Range("Data"), ActiveSheet.UsedRange)
For Each cell_search In rng
    If (cell_search.Value) = "9999" Then

'您的特定细胞值在这里

        If del Is Nothing Then
            Set del = cell_search
            Else: Set del = Union(del, cell_search)
        End If
    End If
    Next cell_search
    On Error Resume Next
    del.EntireRow.Delete
End Sub