Excel VBA - 向宏添加函数以删除包含特定文本的行

时间:2017-06-07 16:36:42

标签: excel vba excel-vba

我是这个网站的新手,也是Excel的新手。我一直在努力创建一个电子表格,并尽可能地自动化它,以便为我自己和我的团队的其他成员简化它。它执行我希望的大部分任务,但仍有一些剩余。这是我目前的代码:

Sub Setup()
'
' Setup Macro
'
' Keyboard Shortcut: Ctrl+e
'
Rows("1:3").Select
Application.CutCopyMode = False
Selection.delete Shift:=xlUp
Cells.Select
ActiveWorkbook.Worksheets("Panel1").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("Panel1").Sort.SortFields.Add Key:=Range("C1:C18") _
    , SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets("Panel1").Sort
    .SetRange Range("A1:Q18")
    .Header = xlGuess
    .MatchCase = False
    .Orientation = xlTopToBottom
    .SortMethod = xlPinYin
    .Apply
End With
Columns("B:B").Select
Cells.Replace What:="RTA", Replacement:="DELETE", LookAt:=xlWhole, _
    SearchOrder:=xlByRows, MatchCase:=True, SearchFormat:=False, _
    ReplaceFormat:=False
Columns("C:C").Select
Selection.Copy
ActiveWindow.ScrollColumn = 2
ActiveWindow.ScrollColumn = 3
ActiveWindow.ScrollColumn = 4
ActiveWindow.ScrollColumn = 5
Columns("O:O").Select
ActiveSheet.Paste
Application.CutCopyMode = False
Selection.TextToColumns Destination:=Range("O1"), DataType:=xlDelimited, _
    TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, _
    Semicolon:=False, Comma:=True, Space:=False, Other:=False, FieldInfo _
    :=Array(Array(1, 1), Array(2, 1)), TrailingMinusNumbers:=True
Columns("O:P").Select
With Selection
    .VerticalAlignment = xlCenter
    .Orientation = 0
    .AddIndent = False
    .IndentLevel = 0
    .ShrinkToFit = False
    .MergeCells = False
End With
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
    .LineStyle = xlContinuous
    .ColorIndex = 0
    .TintAndShade = 0
    .Weight = xlThin
End With
With Selection.Borders(xlEdgeTop)
    .LineStyle = xlContinuous
    .ColorIndex = 0
    .TintAndShade = 0
    .Weight = xlThin
End With
With Selection.Borders(xlEdgeBottom)
    .LineStyle = xlContinuous
    .ColorIndex = 0
    .TintAndShade = 0
    .Weight = xlThin
End With
With Selection.Borders(xlEdgeRight)
    .LineStyle = xlContinuous
    .ColorIndex = 0
    .TintAndShade = 0
    .Weight = xlThin
End With
With Selection.Borders(xlInsideVertical)
    .LineStyle = xlContinuous
    .ColorIndex = 0
    .TintAndShade = 0
    .Weight = xlThin
End With
With Selection.Borders(xlInsideHorizontal)
    .LineStyle = xlContinuous
    .ColorIndex = 0
    .TintAndShade = 0
    .Weight = xlThin
End With
Columns("N:N").Select
ActiveWindow.LargeScroll ToRight:=-1
Columns("A:N").Select
Range("N1").Activate
Selection.EntireColumn.Hidden = True
End Sub

我目前最挣扎的事情是向此宏添加一个函数,该函数将找到一个特定的文本字符串,并删除包含它的整个行。我见过很多人建议使用Autofilter,但我需要完全删除该行,而不仅仅是隐藏。我也发现了许多非常棒的独立解决方案,但我似乎无法弄清楚如何将它们集成到这个宏中,只能将它们作为一个新模块。而且我还尝试将一个删除工作表行操作纳入宏认为如果我先进行查找和替换,它只会删除该特定行,但它最终会删除我的整个工作表。

正如我所说,它现在所做的是查找(RTA)和替换(删除),因为我试图去删除表格行路线,但最终我需要它做的是搜索列B的文本RTA并删除包含它的行。

此外,有没有办法同时在两个工作表(Panel1,Panel2)上运行,还是需要在两个工作表上独立执行?

非常感谢所有人的帮助,我非常感激。我会继续尝试自己解决这个问题,但显然我已经花了太多时间来完成这项任务......

1 个答案:

答案 0 :(得分:0)

你可以试试这个。 sub将查找给定范围内的特定字符串,并删除包含该字符串的所有行(和整行)。

Sub CleanRange(R As Range, T As String)
Dim I As Long, F As Object
Dim M As Long, N As Long, P As Long, Q As Long
M = R.Row
N = R.Column
P = M + R.Rows.Count - 1
Q = N + R.Columns.Count - 1
I = M
While I <= P
    Set F = Range(Cells(I, N), Cells(I, Q)).Find(T, LookIn:=xlValues)
    If F Is Nothing Then
        I = I + 1
    Else
        Rows(I).Delete
        P = P - 1
    End If
Wend
End Sub

征集实例

Call CleanRange(Range("A1:C8"), "2")

如果您要在单个列中查找T,则可以直接简化和使用单元格(I,K)。值。

可以对此进行调整以在多张纸上进行操作,或者查找多个字符串。

如果您总是在B栏中查找,可以写

Sub CleanRange(R As Range, T As String)
Dim I As Long
Dim M As Long, N As Long, P As Long, Q As Long
M = R.Row
N = R.Column
P = M + R.Rows.Count - 1
Q = N + R.Columns.Count - 1
I = M
While I <= P
    If Cells(I, 2).Value = T Then
        Rows(I).Delete
        P = P - 1
    Else
        I = I + 1
    End If
Wend
End Sub

甚至

Sub CleanRange(R1 As Long, R2 As Long, T As String)
Dim I As Long
Dim M As Long, N As Long, P As Long, Q As Long
M = R1
P = R2
I = M
While I <= P
    If Cells(I, 2).Value = T Then
        Rows(I).Delete
        P = P - 1
    Else
        I = I + 1
    End If
Wend
End Sub

注意While很重要,而不是更明显的For循环,因为当你删除行时,访问的最后一行向上移动,因此循环的限制减少了(这就是为什么有P = P - 1)。

然后,如果你想在另一个sub中调用这个sub,你将有

Sub Something(...)
!Declarations
!Do whatever you want here (initialisation...)

!Then do the call, with the appropriate range and string, here is an example
Call CleanRange(Range("A1:C100"), "2")

!Do whatever you want
End Sub