删除在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

在TH调试中,它说以下行有一个问题:

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

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

您如何做?

预先感谢!

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

最新更新