不要な行を消したい

データが50000行くらいあり、そのうち半分は、A列が０となっており、この行を消したいのですが
フィルタをかけて削除すると、作業時間中にフリーズしてしまいます。
1000行ずつ分けて削除すれば、時間はかかるもののフリーズしないのですが
中途半端な時間で難度も同じ作業をするのは、効率が悪いです。
何かよい方法はないでしょうか？

マクロに記録しても、やはり50000行はフリーズしていまいます。

なお、消したい行は必ず１行おきになっています。

No.1 ベストアンサー 回答者： t_fumiaki 回答日時： 2018/02/01 17:38

そのままだと、1行置きに削除＋前詰めが発生する為、作業領域が大きくなり処理も複雑になってしまう。

A列をキーにして並べ替えてから、フィルタをかけて削除する。

処理後、元の並びに戻したいのなら、事前にどこかの列に連番を振っておく。

この回答へのお礼

そのでがありましたね。

お礼日時：2018/02/01 21:00

No.2 回答者： tom04 回答日時： 2018/02/01 19:37

こんばんは！

データ数が約5万行もあると単純にループさせても「応答なし」になると思いますし、
オートフィルタで「0」以外を表示できても表示されている行数約半数の25000行程度だと
その行を削除しても相当時間を要すると思います。
そこで別案ですが、
元データはSheet1にあり、A列が「0」以外のデータをSheet2に表示するのはどうでしょうか？

標準モジュールにしてください。

Sub Sample1()
Dim myDic As Object
Dim i As Long, k As Long
Dim lastRow As Long, lastCol As Long
Dim myStr As String, wS As Worksheet
Dim myKey, myItem, myR, myAry1, myAry2
Set myDic = CreateObject("Scripting.Dictionary")
Set wS = Worksheets("Sheet2")
wS.Cells.ClearContents
With Worksheets("Sheet1")
lastRow = .Cells(Rows.Count, "A").End(xlUp).Row
lastCol = .Cells(1, Columns.Count).End(xlToLeft).Column
myR = Range(.Cells(1, "A"), .Cells(lastRow, lastCol))
For i = 1 To UBound(myR, 1)
If myR(i, 1) <> 0 Then
For k = 2 To lastCol
myStr = myStr & "_" & myR(i, k)
Next k
myDic.Add i & "_" & myR(i, 1), myStr
End If
myStr = ""
Next i
End With
myKey = myDic.keys
myItem = myDic.items
myR = Range(wS.Cells(1, "A"), wS.Cells(UBound(myKey) + 1, lastCol))
For i = 0 To UBound(myKey)
myAry1 = Split(myKey(i), "_")
myAry2 = Split(myItem(i), "_")
myR(i + 1, 1) = myAry1(1)
For k = 1 To UBound(myAry2)
myR(i + 1, k + 1) = myAry2(k)
Next k
Next i
Range(wS.Cells(1, "A"), wS.Cells(UBound(myKey) + 1, lastCol)) = myR
Set myDic = Nothing
wS.Activate
MsgBox "完了"
End Sub

※　値のみの表示としていますので、書式などは無視されます。m(_ _)m

この回答へのお礼

ありがとうございました。
参考にさせていただきます。

もう一人の方へ。
途中でお礼を送ってしまいました。すみません。実は、すでに消したB行には、時間が乗っていたので、これでソーティングすれば良いことを思い出しました。前にやった時はそうしていたのに、今日は以前の作業を忘れて、8時間かけてフリーズと戦い、無駄な時間を過ごしてしまいました。ありがとうございます。

お礼日時：2018/02/01 21:04