找到具有特定值的单元格,然后删除所有行

问题描述 投票:0回答:3

在工作中我有点头脑。

我正在开发一个快速的Excel工具来帮助我在工作中做报告。我们的订单管理软件可以导出到Excel,但数据需要一些修整。有3列有我需要的信息(C,D和R)。

我需要做的是在C列中找到一个特定的值,删除之后的所有内容,并删除除D和R之外的所有行。到目前为止,我已经能够通过录制宏来完成后半部分但是我遇到了麻烦首先。

这是我到目前为止通过宏录制生成的。

Sub SortCopy()
'
' SortCopy Macro
'
' Keyboard Shortcut: Ctrl+w
'
    Range("A:C,E:Q,S:AN").Select
    Range("S1").Activate
    Selection.Delete Shift:=xlToLeft
    Columns("A:B").Select
    ActiveWorkbook.Worksheets("Sorting").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Sorting").Sort.SortFields.Add Key:=Range("A2:A3436") _
        , SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("Sorting").Sort
        .SetRange Range("A1:B4000")
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    Range("A1:B1102").Select
    Selection.Copy
End Sub

我没有VBA的经验。我已经离开了这个联盟。

excel vba excel-vba
3个回答
0
投票

VBA并不那么可怕,只需要一次试验和错误。像你在这里录制的宏是学习和查看它如何工作的最佳方式。不幸的是,宏录制不会告诉你如何进行条件(if-else)语句或循环,我认为你需要做你想做的事情。以下是一些可以添加到宏的基本循环代码:

Dim found As Boolean
found = False
' start loop
Do While ActiveCell.Value <> Empty

    ' check cell for specific value
    If ActiveCell.Value = "whatever" Then
        found = True
        ActiveCell.Offset(1, 0).Select
    End If

    If found Then
        ' delete row
        ActiveCell.EntireRow.Delete (xlShiftUp)
    Else
        ' move down a cell
        ActiveCell.Offset(1, 0).Select
    End If

Loop

有更有效的方法可以做到这一点,不涉及选择单元格,但我认为这是最容易理解的,并且看到它在调试器中工作(按F8键)。


0
投票

试试这个,我认为它会做你想要的。

Sub Trim_Data()
    Dim X as Integer
    Dim Last_Val as String
    Last_Val = InputBox(“Enter the value you wish to find in the data:”,”Enter last Value”,””)
    If Last_Val = “” then Exit Sub
    For X = 1 to 10000
        If Range(“C” & X).Value = Last_Val then Goto Found_It
    Next X
    Last_Val = MsgBox(“The entered Value was not found.”, vbcritical)
    Exit Sub
Found_It:
    Range(“A” & (X + 1) & “:A10000”).EntireRow.Delete
    Range(“S1:ZZ1”).EntireColumn.Delete
    Range(“E1:Q1”).EntireColumn.Delete
    Range(“A1:C1”).EntireColumn.Delete
End Sub

0
投票

这是一种可行的方法。而是每次删除数据,将数据保留在自己的工作表中,然后根据该数据创建视图。我正在使用ADO,这可能是不熟悉的更多信息here

这是我的数据设置,所有数据都在一张名为Raw的表格中。我创建了一个名为View的新工作表,这是查询完成后数据的位置。我通过创建18个不同的字段(或列)来模拟您的数据集。我把它们命名为Field 1Field 2Field 3 ......一直到`Field 18,再次在数据表中。确保您的数据包含标题,例如有意义的名字在同一行。

我假设您正在寻找String而不是DateNumeric类型,因此查询被设计为一个简单的示例,因此只适用于String。它可以修改为不同的类型:)

要清楚,我指的是代码的这一部分:

SQL = "Select [Field 3], [Field 4], [Field 18] from [Raw$] Where [Field 3] = '" & LookFor & "'"

运行sub caller,应该在View表中显示结果。

Public Sub CreateView(LookFor As String)
    Dim Conn        As Object
    Dim SQL         As String
    Dim rs          As Object
    Dim outSheet    As Worksheet
    Const adStateOpen = 1

    'The view sheet is where the data will go to
    Set outSheet = ThisWorkbook.Worksheets("View")

    'Field 3 = Column C, Field 4 = Column D
    'If your field has headers use that, otherwise, add headers
    SQL = "Select [Field 3], [Field 4], [Field 18] from [Raw$] Where [Field 3] = '" & LookFor & "'"

    Set Conn = CreateObject("ADODB.Connection")

    'Connect to current spreadsheet
    Conn.connectionstring = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & ThisWorkbook.FullName & _
                            ";Extended Properties='Excel 12.0;HDR=YES';"
    Conn.Open

    'Get the recordset
    Set rs = Conn.Execute(SQL)

    'Add the data to the view sheet
    With outSheet
        .Cells.ClearContents
        .Range("A1:C1").Value = Array("Field 1", "Field 3", "Field18")
        .Range("A2").CopyFromRecordset rs
        .Activate
    End With

    'Close the connection if it's open
    If Conn.State = adStateOpen Then Conn.Close
End Sub

Private Sub caller()
    'This is the caller routine
    Application.ScreenUpdating = False
    Dim searchCriteria As String
    searchCriteria = InputBox("Enter the search field", "Enter criteria")
    CreateView (searchCriteria)
    Application.ScreenUpdating = True
End Sub
© www.soinside.com 2019 - 2024. All rights reserved.