Question

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

Private Sub CommandButton1_Click()

 Dim ws As Worksheet
 Dim rng As Range
 Dim lastRow As Long
 Dim myCell As Range

iPath = "C:\Users\dbutler\Desktop\Folder_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）以从底部开始删除。

提取相关信息Excel VBA

1 个答案: