一次删除所有行，一旦选择

Question

考虑下面的 Excel：

Id    Col1     Col2     Col3   Col4
25     s        p         n    
11     a        t         x     g
17                        r     t
10     a                  a     e
66     a                  a

假设我有一个包含 ID 号的数组
例如Arr=(25,11,66)

是否可以一次删除该数组中ID号所在的所有行？

我需要先选择它们吗？

代码：

 Option Explicit

 Dim arr,objExcel1,strPathExcel1,objSheet1


 Set objExcel1 = CreateObject("Excel.Application")'Object for Condition Dump
 strPathExcel1 = "D:\VA\Test.xlsx"
 objExcel1.Workbooks.open strPathExcel1

 Set objSheet1 = objExcel1.ActiveWorkbook.Worksheets(4)


 arr = Array(5,11,66)

 objSheet1.Range("A" & Join(arr, ",A")).EntireRow.Delete

错误“未知的运行时错误”——我收到了

Answer 1

这是一种蛮力方法。 根据 OP 的后续评论更新

代码：

Option Explicit


Sub overWriteRows()
Dim d As Object
Dim wkSheet As Worksheet
Dim myRange As Range
Dim myArray As Variant
Dim deleteArray As Variant
Dim finalArray As Variant
Dim upBound As Long, i As Integer
Dim j As Integer, k As Integer, m As Integer

Set d = CreateObject("scripting.dictionary")
Set wkSheet = Sheets("Sheet1") '-- set your own sheet e.g. Sheet2
Set myRange = wkSheet.Range("B3:F8") '-- set your own range e.g. "B2:E5"

'-- validate if range is null or not
If myRnage is nothing then
  Exit Sub
End if

myArray = Application.WorksheetFunction.Transpose(myRange)
'-- now if you do not have delete range in a sheet range then
    '-- you may populate the dictionary right away manually so
        '-- you do not need deleteArray
deleteArray = Application.WorksheetFunction.Transpose(Range("G3:I3"))
'-- if you are populating dictionary manually then
    '-- you may set upBound = Ubound(myArray,2) - d.Count
upBound = UBound(myArray, 2) - UBound(deleteArray)
ReDim finalArray(LBound(myArray, 2) To upBound, LBound(myArray) To UBound(myArray))

'-- replace this with your manual dictionary population code
For i = LBound(deleteArray) To UBound(deleteArray)
    If Not d.exists(deleteArray(i, 1)) Then
        d.Add deleteArray(i, 1), i
    End If
Next i

    k = 1

    For j = LBound(myArray, 2) To UBound(myArray, 2)
        If Not d.exists(myArray(1, j)) Then
        '-- if you want to remove even duplicate records then u can use this
           'd.Add myArray(1, j), k 
                For m = LBound(myArray) To UBound(myArray)
                    finalArray(k, m) = myArray(m, j)
                Next m
                k = k + 1
        End If
    Next j

'-- you may use following code to flush old row data
    'myRange.Value = ""
'-- output the new array to sheet by over writing the old range
'-- you may use myRange instead of "B11" to overwrite old data with filtered data
    wkSheet.Range("B11").Resize(UBound(finalArray), _ 
         UBound(Application.Transpose(finalArray))) = finalArray

    Set d = Nothing
End Sub

输出

Answer 2

EDIT：进一步优化代码

编辑：使用字典避免嵌套循环以提高性能

还请注意，由于标签是 vba & vbs，所以这里给出的答案是兼容的。

这个解决方案是删除整行而不是只包含数据的范围。

编辑：更新代码以将 A 列的值与 Arr 中的值匹配

假设从第 2 行开始的值是数字

您可以使用Excel提供的录制宏功能来观察Range Object的样子

http://spreadsheets.about.com/od/advancedexcel/ss/080703macro2007.htm

Sub t()
    Dim str
    Dim arr
    Dim i
    arr = Array(1, 2, 4)
    Dim row
    Dim height
    Dim found
    Dim dataArray
    Dim d
    height = Cells(Rows.Count, 1).End(-4162).row
    ReDim dataArray(height - 2, 0) ' -1 for 0 index, -1 for the first row as header row, excluded
    str = ""
    dataArray = Range(Cells(2, 1), Cells(height, 1)).Value
    Set d = CreateObject("scripting.dictionary")
    For i = LBound(arr) To UBound(arr)
        If Not d.exists(arr(i)) Then
            d(arr(i)) =  0
        End If
    Next
    For i = LBound(dataArray, 1) To UBound(dataArray, 1)
        If d.exists(dataArray(i, 1)) Then
            'found in column 1
            str = str & i & ":" & i & ","
        Else
            'found = False
        End If
    Next
    If Len(str) > 0 Then
        str = Mid(str, 1, Len(str) - 1)
        Range(str).Delete

    End If

End Sub

Answer 3

不是答案，而是关于优化@Larry 解决方案的思考：

>> a = Array(1, 3, 5, 5, 3, 1)
>> b = Array(1, 2, 3, 4, 5, 6)
>> set c = CreateObject("Scripting.Dictionary")
>> for i = 0 To UBound(a)
>>   c(a(i)) = 0
>> next
>> for i = 0 To Ubound(b)
>>     if c.Exists(b(i)) then
>>        WScript.Echo "delete", i, b(i)
>>     end if
>> next
>>
delete 0 1
delete 2 3
delete 4 5

1. 使用 dic(key)=value 而不是通过 .Exists 进行检查
2. 通过利用 .Exists 返回 bool 的事实来避免额外的变量（找到）