いくつかの非常に大きな Excel データ ファイルがあり、それらすべてを調べて、列 T のセルの値が 1 であるすべての行を削除する必要があります。現在、私のコードは次のようになっています。
Sub test()
Dim cell As Range
For Each cell In Worksheets("Sheet1").Range("T5", "T900000")
If cell.Value = 1 Then
cell.EntireRow.Delete
End If
Next cell
End Sub
動作しているように見えますが、実行に時間がかかるため、これを何度も実行する必要があります。これを行うためのより良い方法、または実行を高速化するために既に必要なものを最適化する方法はありますか?
これはあなたが思うようには機能しません...行を繰り返し処理しながら行を削除すると、行をスキップすることになります。例: 行の A 列に 1 ～ 10 の数字があるとします。最初の行を見て、それを削除することにしました。次に、2 行目を見てください。3番があります！あなたは行2を見たことがない!!
より良い方法は、列 T の基準でスプレッドシートをフィルタリングし、それをコピーして、新しいワークシートに貼り付けることです (書式設定などを使用)。
マクロの記録をオンにして、これを手動で行うことができます。次に、正確な VBA コードを取得します。私はそれがはるかに速くなると確信しています。
それをしなくても、ものを削除するところをやりたい場合はfor each、順序を逆にします（最後から始めて、逆に作業します）。
ループを使用したい場合、以下はアイテムをスキップすべきではありません。@Floris Filter メソッドの方が速いかもしれません。
Sub Main()
Dim Row As Long
Dim Sheet As Worksheet
Row = 5
Set Sheet = Worksheets("Sheet1")
Application.ScreenUpdating = False
Do
If Sheet.Cells(Row, 20).Value = 1 Then
Sheet.Rows(Row).Delete xlShiftUp
Else
Row = Row + 1
End If
Loop While Row <= 900000
Application.ScreenUpdating = True
End Sub
更新ループ
を切り替えましApplication.ScreenUpdatingた。これにより、通常、このようなものが大幅に高速化されます!
データベースのようにデータを管理していて、そこから特定の行を削除したい場合、それらをフィルタリングすることができます。削除プロセスをスピードアップするためのトリックがあります。これは、単純なループ プロセスとは対照的に非常に高速です。
さまざまな例 (4806 行) の時間を比較します。
例: 「Tabelle5」にデータがあり、特定の行を削除したいと考えています。データは行 6 から始まります。「OLD#」で始まる列 1 のすべての行を削除する必要があります。
1) 標準解 (最長時間):
Dim i As Integer, counter As Integer
Dim strToRemove As String, strToRemoveRange As String
strToRemove = "OLD#"
strToRemoveRange = ""
counter = 0
With Tabelle5
For i = .UsedRange.Rows.Count To 6 Step -1
If Mid(.Cells(i, 1).value, 1, 4) = strToRemove Then
.Rows(i).Delete Shift:=xlUp
End If
Next i
End With
2) ここでレンジ ソリューション (中間時間):
Dim i As Integer, counter As Integer
Dim strToRemove As String, strToRemoveRange As String
strToRemove = "OLD#"
strToRemoveRange = ""
counter = 0
With Tabelle5
For i = .UsedRange.Rows.Count To 6 Step -1
If Mid(.Cells(i, 1).value, 1, 4) = strToRemove Then
If strToRemoveRange = "" Then
strToRemoveRange = CStr(i) & ":" & CStr(i)
Else
strToRemoveRange = strToRemoveRange & "," & CStr(i) & ":" & CStr(i)
End If
counter = counter + 1
End If
If counter Mod 25 = 0 Then
If counter > 0 Then
.Range(strToRemoveRange).Delete Shift:=xlUp
strToRemoveRange = ""
counter = 0
End If
End If
Next i
If Len(strToRemoveRange) > 0 Then
'.Range(strToRemoveRange).Delete Shift:=xlUp
End If
End With
3) ろ過液 (最短時間):
Dim i As Integer, counter As Integer
Dim strToRemove As String, strToRemoveRange As String
strToRemove = "OLD#"
strToRemoveRange = ""
counter = 0
With Tabelle5
For i = .UsedRange.Rows.Count To 6 Step -1
If Mid(.Cells(i, 1).value, 1, 4) = strToRemove Then
.Cells(i, 1).Interior.Color = RGB(0, 255, 0)
counter = counter + 1
End If
Next i
If counter > 0 Then
.Rows("5:5").AutoFilter
.AutoFilter.Sort.SortFields.Clear
.AutoFilter.Sort.SortFields.Add( _
Range("A5"), xlSortOnCellColor, xlAscending, , xlSortNormal).SortOnValue.Color = RGB(0, 255, 0)
.AutoFilter.Sort.Header = xlYes
.AutoFilter.Sort.MatchCase = False
.AutoFilter.Sort.Orientation = xlTopToBottom
.AutoFilter.Sort.SortMethod = xlPinYin
.AutoFilter.Sort.Apply
.Rows("6:" & CStr(counter + 5)).Delete Shift:=xlUp
.Rows("5:5").AutoFilter
End If
End With
ここでは、緑色の線が上に並べられ、緑色のヒットの範囲が全体として削除されます。それが私が知っている最速の方法です！:-)
それが誰かを助けることを願っています！
よろしくトム
私が見つけた最も簡単な方法は、行データ (.clear) をクリアしてからソートすることです。たとえば、「 ========= 」と表示される改ページを削除したい
I=20
Do While i <= lRow3
If Left(Trim(ws3.Cells(i, 1)), 1) = "=" Then
ws3.Range(Rows(i - 7), Rows(i + 2)).Clear
'i = i - 7
'lRow3 = lRow3 - 10
End If
i = i + 1
Loop
並べ替えてから、xlUp の最後の行 (ws3.Range("A1000000").End(xlUp).Row) などを実行します。
行の削除 (約 220,000 行の私のファイルの 1 つ) には 3 分かかります。内容の消去には 10 秒もかかりません。
問題は、これが行われる前にデータを行の下から上の行に移動する必要がある場合、空の行を「削除」する方法になります。:)
乾杯、BJ