【问题标题】:Macros to Remove Unwanted Content删除不需要的内容的宏
【发布时间】:2018-05-31 12:54:38
【问题描述】:

我正在尝试创建一个宏代码,我可以从中按 VBA 播放,当满足条件时,它会删除整行。我希望代码查找的关键搜索是“PEDS”,但需要注意的重要一点是,PEDS 后面有数字(即 PEDS1234),这些数字几乎就像一个变量并发生变化。

你能帮我解决这个问题吗,因为我被困在这个问题上。

我创建的当前代码就像一个过滤器,不会自动删除数据。

Option Explicit

Sub KillRows()

    Dim MyRange As Range, DelRange As Range, C As Range
    Dim MatchString As String, SearchColumn As String, ActiveColumn As String
    Dim FirstAddress As String, NullCheck As String
    Dim AC

     'Extract active column as text
    AC = Split(ActiveCell.EntireColumn.Address(, False), ":")
    ActiveColumn = AC(0)

    SearchColumn = InputBox("Enter Search Column - press Cancel to exit sub", "Row Delete Code", ActiveColumn)

    On Error Resume Next
    Set MyRange = Columns(SearchColumn)
    On Error GoTo 0

     'If an invalid range is entered then exit
    If MyRange Is Nothing Then Exit Sub

    MatchString = InputBox("Enter Search string", "Row Delete Code", ActiveCell.Value)
    If MatchString = "" Then
        NullCheck = InputBox("Do you really want to delete rows with empty cells?" & vbNewLine & vbNewLine & _
        "Type Yes to do so, else code will exit", "Caution", "No")
        If NullCheck <> "Yes" Then Exit Sub
    End If

    Application.ScreenUpdating = False

     'to match the WHOLE text string
    Set C = MyRange.Find(What:=MatchString, After:=MyRange.Cells(1), LookIn:=xlValues, Lookat:=xlWhole)
     'to match a PARTIAL text string use this line
     'Set C = MyRange.Find(What:=MatchString, After:=MyRange.Cells(1), LookIn:=xlValues, Lookat:=xlpart)
     'to match the case and of a WHOLE text string
     'Set C = MyRange.Find(What:=MatchString, After:=MyRange.Cells(1), LookIn:=xlValues, Lookat:=xlWhole, MatchCase:=True)

    If Not C Is Nothing Then
        Set DelRange = C
        FirstAddress = C.Address
        Do
            Set C = MyRange.FindNext(C)
            Set DelRange = Union(DelRange, C)
        Loop While FirstAddress <> C.Address
    End If

     'If there are valid matches then delete the rows
    If Not DelRange Is Nothing Then DelRange.EntireRow.Delete

    Application.ScreenUpdating = True

End Sub

【问题讨论】:

  • 我试过你的代码,当你在你的行前面放一个'时它工作正常: Set C = MyRange.Find(What:=MatchString, After:=MyRange.Cells(1), LookIn :=xlValues, Lookat:=xlWhole) 并同时删除 'Set C = MyRange.Find(What:=MatchString, After:=MyRange.Cells(1), LookIn:=xlValues, Lookat: =xlpart)
  • 好的,修复了那部分。我唯一担心的是,我希望播放选项自动执行此操作,而不是我必须输入它。我对 VBA 还很陌生,所以我一直在混合和匹配在线代码以实现这一目标。
  • 如果您知道要查看的列,则只需删除“Searchcolumn = ....”之后的文本,并将其设为“Searchcolumn = A”,例如。在 Matchstring 之后,删除所有代码,直到 Application.Screenupdating = False 并将其替换为:“Matchstring = “PEDS”。我会尽快将其放入答案中......

标签: vba excel


【解决方案1】:
Option Explicit

Sub KillRows()

    Dim MyRange As Range, DelRange As Range, C As Range
    Dim MatchString As String, SearchColumn As String, ActiveColumn As String
    Dim FirstAddress As String, NullCheck As String
    Dim AC

    SearchColumn = "A" 'This is a new line    
    Set MyRange = Columns(SearchColumn)
    MatchString = "PEDS"

    Application.ScreenUpdating = False

     'to match a PARTIAL text string use this line
     Set C = MyRange.Find(What:=MatchString, After:=MyRange.Cells(1), LookIn:=xlValues, Lookat:=xlpart)

    If Not C Is Nothing Then
        Set DelRange = C
        FirstAddress = C.Address
        Do
            Set C = MyRange.FindNext(C)
            Set DelRange = Union(DelRange, C)
        Loop While FirstAddress <> C.Address
    End If

     'If there are valid matches then delete the rows
    If Not DelRange Is Nothing Then DelRange.EntireRow.Delete

    Application.ScreenUpdating = True

End Sub

您可以比我更多地清理您的代码。但这是一个开始,应该会奏效。

顺便说一句:谷歌代码没有错。这是一种很好的学习方式。我也是这样开始的......Google 是你最好的朋友。

【讨论】:

    猜你喜欢
    • 2012-09-29
    • 1970-01-01
    • 1970-01-01
    • 1970-01-01
    • 2012-11-18
    • 2013-11-19
    • 1970-01-01
    • 2021-02-02
    • 1970-01-01
    相关资源
    最近更新 更多