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编号在该数组中的所有行？

我是否需要先选择它们？

CODE：

 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

编辑：进一步优化代码

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

请注意，因为标签是vba＆amp; vbs，所以这里给出的答案兼容。

此解决方案是删除整行而不是仅包含数据的范围。

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

假设第2行以后的值是Numeric

您可以使用Excel提供的记录宏功能来观察范围对象的样子

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 2

这是一种蛮力方法。 根据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

<强>输出

enter image description here

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

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

选择后，一次删除所有行

3 个答案: