0

以下の 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

ERROR "Unknown Runtime Error" -- 取得しています

4

3 に答える 3

2

編集:コードをさらに最適化する

編集:辞書を使用してネストされたループを回避し、パフォーマンスを向上させます

タグは vba と vbs であるため、ここに示す回答は両方で互換性があることにも注意してください。

そして、この解決策は、データのみを含む範囲ではなく、行全体を削除しています。

EDIT : 列 A の値を Arr 内の値と一致させるようにコードを更新しました

行 2 以降の値が数値であると仮定します。

Excel が提供するレコード マクロ機能を使用して、Range オブジェクトの様子を観察できます。

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
于 2012-12-18T10:38:02.280 に答える
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

出力

ここに画像の説明を入力

于 2012-12-18T11:48:20.323 に答える
1

答えではありませんが、@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. .Exists によるチェックの代わりに dic(key)=value を使用する
  2. .Exists が bool を返すという事実を利用して、余分な変数 (見つかった) を回避する
于 2012-12-18T13:12:14.677 に答える