删除excel

Question

这是一个棘手的问题。

我有一个Excel文件，其中包含工作簿中10个工作表中的大约4000篇文章。我想只保留约400篇文章，剩余的3600篇文章应该删除。

工作簿中的所有工作表都有A列中的文章ID。

所有工作表在第1-5行都有标题。

文章ID在某些工作表中可以存在多次。

我想在Visual Basic脚本中列出400篇文章ID，这样我就不必创建包含这些信息的单独工作表或列。

有人可以帮帮我吗？我尝试了很多脚本，但似乎没有任何工作......

在下面的示例中，我想保留文章ID的5和1（当然还有标题）。其余5行应删除

这就是我的尝试：

Sub Delete()
Dim Firstrow As Long
Dim Lastrow As Long
Dim Lrow As Long
Dim CalcMode As Long
Dim ViewMode As Long

With Application
CalcMode = .Calculation
.Calculation = xlCalculationManual
.ScreenUpdating = False
End With

With ActiveSheet
.Select
ViewMode = ActiveWindow.View
ActiveWindow.View = xlNormalView
.DisplayPageBreaks = False
Firstrow = 6
Lastrow = .Cells(.Rows.Count, "A").End(xlUp).Row

For Lrow = Lastrow To Firstrow Step -1
    With .Cells(Lrow, "Y")
        If Not IsError(.Value) Then
            If InStr(.Value, 1) = 0 Or InStr(.Value, 5) = 0 Then  .EntireRow.Delete
        End If
    End With
 Next Lrow
End With
End Sub

但是，我有两个问题：

1. 删除所有行包括我要删除的行（1和5）。

2. 它仅适用于打开的工作表，而不适用于整个工作簿。

亲切的问候，

彼得

Answer 1

试试这段代码。在开始时，它会询问您要在所有工作表中保留哪些ID。在那里输入以逗号（,）分隔的数字，不允许使用逗号和数字以外的空格或字符。

Sub DeleteArticles()
Dim i As Long
Dim strIDToKeep As String
Dim arrIDToKeep() As String
Dim ws As Worksheet
Dim lastRow As Long
strIDToKeep = InputBox("What IDs to keep?")
arrIDToKeep = Split(strIDToKeep, ",")

For Each ws In Worksheets
    lastRow = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row
    For i = lastRow To 6 Step -1
        'if ID isn't present in array of IDs to keep, then we delete entire row
        If UBound(Filter(arrIDToKeep, ws.Cells(i, 1).Value)) = -1 Then
            ws.Rows(i).EntireRow.Delete
        End If
    Next
Next
End Sub

Answer 2

试试此代码

Sub Test()

    Dim ws As Worksheet
    For Each ws In ThisWorkbook.Worksheets
        Dim i As Long
        For i = 10 To 2 Step -1
            Select Case ws.Cells(i, 1).Value
            'add your ids for which you don't want to delete the rows
            Case 1, 5
                'do nothing
            Case Else
                ws.Cells(i, 1).EntireRow.Delete
            End Select
        Next i
    Next ws

End Sub