提取相关信息 Excel VBA

Question

我希望从位于文件夹中的多个文本文件中提取信息，将它们放在单独的工作表上，并仅保留每个工作表中的相关信息。我在删除不需要的行时遇到问题，我正在为行着色，以便对相关信息进行排序。下面提供的代码。谢谢

Private Sub CommandButton1_Click()
 Dim ws As Worksheet
 Dim rng As Range
 Dim lastRow As Long
 Dim myCell As Range
iPath = "C:UsersdbutlerDesktopFolder_1" 'Imports the text files from Folder address  
iFile = Dir(iPath & "*.txt")
Do While Len(iFile)
Sheets.Add , Sheets(Sheets.Count), , iPath & iFile
iFile = Dir
Loop
'Selects every sheet but Command
For Each ws In ThisWorkbook.Worksheets
    If ws.Name <> "Command" Then
        lastRow = ws.Range("A" & ws.Rows.Count).End(xlUp).Row
        Set rng = ws.Range("A1:A" & lastRow)
        'filter and delete all rows
        For Each myCell In rng
'Delete rows if they do not contain the below values
            If Not (myCell Like "*10570*" Or _
                myCell Like "*10571*" Or _
                myCell Like "*10572*" Or _
                myCell Like "*11503*" Or _
                myCell Like "*10308*" Or _
                myCell Like "*11324*" Or _
                myCell Like "*18368*" Or _
                myCell Like "*13369*" Or _
                myCell Like "*15369*" Or _
                myCell Like "*10814*" Or _
                myCell Like "*22306*" Or _
                myCell Like "*12009*" Or _
                myCell Like "*15088*" Or _
                myCell Like "*72216*") Then
                myCell.EntireRow.Delete

            End If
            Next myCell

End If
Next ws
End Sub

Answer 1

.entirerow.delete是正确的。我认为您的问题在于当您开始从顶部删除时数据的变化。

尝试使用

    For I = lastrow To 1 Step -1
        Set mycell = ws.Cells(I, 1)

而不是你的每个循环。（将下一条语句更改为Next I）从底部开始删除。