エクセルの行の削除を配列で高速化したい

Question

A列にID番号（012345等の文字列化した数字）
B列に属性（A、B、C等の文字列）
C列に数値　
のようなデータがあります。

1行目はタイトル行です。
最優先されるキーをA列、2番目に優先されるキーをB列にして並べ替えてあります。
A列、B列のデータは重複するものがあります。
このデータを、
A列のID番号が同じだった場合、上の属性がA、次の行の属性がBの組み合わせだった場合のみ、下の行のC列の数値データを上の行のC列の数値に加算して、下の行を削除します。
以下のマクロを書き、うまくいきました。

Sub 集計()
    Dim i As Long, r As Long
    r = Cells(65536, 1).End(xlUp).Row
    Application.ScreenUpdating = False
    For i = r To 2 Step (-1)
        If Cells(i, 1) = Cells(i - 1, 1) Then
            If Cells(i, 2) = "B" And Cells(i - 1, 2) = "A" Then
                Cells(i - 1, 3) = Cells(i - 1, 3) + Cells(i, 3)
                Rows(i).Delete
            End If
        End If
    Next
    Application.ScreenUpdating = False
End Sub

しかし、データ数が多いので1分以上かかってしまいます。
多分、配列に取り込んで処理できれば飛躍的に高速化できるとは思うのですが、
V = Range(Cells(2, 1), Cells(r, 3)).Value
と取り込んだあと、どう処理したらいいのかわかりません。
教えてください。

ki-aaa · Accepted Answer

試してみて

Sub 集計()
    Dim i As Long, r As Long, j As Long
    Dim v, vv
    
    With ThisWorkbook.Sheets("Sheet1")
    r = .Cells(65536, 1).End(xlUp).Row
    Application.ScreenUpdating = False
    v = .Range("A1").Resize(r, 3).Value '一行多く取得
    ReDim vv(1 To UBound(v), 1 To 3)
    
    For i = 2 To r
        If v(i - 1, 1) = v(i, 1) And _
           v(i - 1, 2) = "A" And v(i, 2) = "B" Then
            vv(j, 3) = vv(j, 3) + v(i, 3)
        Else
            j = j + 1
            vv(j, 1) = v(i, 1)
            vv(j, 2) = v(i, 2)
            vv(j, 3) = v(i, 3)
        End If
    Next i
    
    .Range("A2").Resize(r - 1, 3).ClearContents
    .Range("A2").Resize(j, 3).Value = vv
    Application.ScreenUpdating = True
    End With
End Sub

Wendy02 · Answer

>このような質問方法はルールに反しているのでしょうか？そうではなくて、車の運転で、横から、スロー・イン・ファースト・アウトを使ってとか、裏道があるから、そちらを使ってとか言われたら、行けると思うなら貴方が運転したら、と言われてしまうと思います。おまけに、#1のお礼のコードで書いたコードは、プロパティの.Value を入れれば、後は、問題ないように思います。なおさら、なぜ、ここまで出来て、自分自身で、配列でトライしないのかって言われかねないと思ってしまいます。こういうことは、お互いの立場を替えれば、分かるような気がしますけれども……。それに、いろんな事情があって、配列を使えるかどうかは、判断出来ないことがあります。最初にテキストデータのリストだということで、初めて配列での処理をすることはあっても、セル上のリストを、配列上で処理して、それを一旦消して、セル上に貼り付けるというような実務上のコードは、覚えがありません。私が、こんなことを言いながら、ミスしていれば、世話ないけれどもね。エラーした理由は、単に、同じようなことをしたくなかったので、新しいテクを探しました。このテクニックを読んで使う人はないとは思いますが、まだ一度も出したことのないテクニックです。配列を配列の一括処理を求めました。まだ、実験段階です。このままでは、みっともないので、直しました。まだ、問題があるかもしれません。 '// Sub TestArray2R() Dim arA, arB, arC, x, i As Long, j As Long Const COL As Integer = 3　'←列数 Const A As String = "A"　'←分類A Const B As String = "B"　'←分類B 　For i = 1 To COL 　 x = x & "," & i 　Next i 　x = Split(Mid(x, 2), ",") 　arA = Range("A2", Cells(Rows.Count, 1).End(xlUp).Offset(1, COL)).Value 　ReDim arB(1 To UBound(arA, 1), 1 To 1) 　ReDim arC(1 To UBound(arA, 1), 1 To UBound(arA, 2)) 　j = 1 　For i = LBound(arA, 1) To UBound(arA, 1) - 1 　　 If i = UBound(arA, 1) - 1 Then 　　　 arB(j, 1) = i 　　 ElseIf arA(i, 1) <> arA(i + 1, 1) Then 　　　 arB(j, 1) = i 　　 ElseIf arA(i, 1) = arA(i + 1, 1) And _ 　　　 arA(i, 2) <> A Or arA(i + 1, 2) <> B Then 　　　 arB(j, 1) = i 　　 ElseIf arA(i, 1) = arA(i + 1, 1) And _ 　　　 arA(i, 2) = A And arA(i + 1, 2) = B Then 　　　 arA(i, 3) = arA(i, 3) + arA(i + 1, 3) 　　　 arB(j, 1) = i 　　　 i = i + 1 　　 End If 　　 j = j + 1 　Next 　arC = Application.Index(arA, arB, x) 　Application.ScreenUpdating = False 　Range("A2").Resize(i, 3).ClearContents 　Range("A2").Resize(j - 1, COL).Value = arC 　Application.ScreenUpdating = True End Sub

layy · Answer

前述のは、
「早くしたい」という観点で気づいたことを回答させてもらいました。

＞「配列」を使えば比較にならないくらい早くなるということは、このサイトや他の情報などで聞いておりましたから。

それなら、
「配列の使い方」ということに絞って質問すれば良かったのでは？と思います。
調べるのをもっとがんばればわかったかもしれません・・・。

データ量、マシンの性能などあって同じ「１秒」近くになるとも限りません。
環境や性能のことに絡んでくると、
再現できないので完全なる答えは期待できないこともあります。
必要な部分だけヒントをもらってあとは自システムへ導入、のが堅いです。

早くなって配列も理解できたと思うので結果は良しですが・・・。

Wendy02 · Answer

最初、直接の回答ではありませんので読み捨てしていただいて良いのですが、少し私の考え方を言わせてもらいます。

>配列での方法を知りたいです。

もし、回答者にコーディング内容に、「配列」などと、スタイル要求するなら、自分でコードを分かる範囲に書いてくたさい。

#2さんには悪いけれども、初級の内容だと思います。VBAをひと通り使えるようになるには、今回は使っていませんが動的配列までは、覚えなくてはなりません。

こちらで試験したら、3列-3万行で、#2さんのコードで、0.7秒程度で完成するはずです。しかし、個別の書式情報などがあると、別に配列に記録したりしたら、かなり面倒なことになります。

ただ、いずれにしても、今回のようなものは実験コードの一種だと思います。レーシング上でチューンされたマシーンと、そのテクニックで、果たして公道でも使えるかということになるのでは、と余計なことを考えてしまいます。

私は、基本的に、掲示板のマクロのスピード競争には参加しないことにしています。
マクロの完成時間というのは、速いことにこしたことはありませんが、概して感覚的・相対的なものですから、使いやすさが大事なのではないかと思います。

もちろん、そんなことは手前勝手なことですから、人には関係ないかもしれませんが、ただ、ループの考え方がきちんと出来ていれば、配列を処理するのは、それほど難しいものではありません。しかし、元のデータが、外部からではなく、もともとがExcelの生データの場合は、いろんな付随情報が加わえているはずです。そうすると、こうした配列を使うわけにはいきません。

なお、こんなことを書く人間は、多くは生ぬるいコードを書く人が多いので、一応、こちらの技量の証拠だけは書いておきます。いろんな状況を調べてはいませんから、完全とは言えないとは思います。ただ、このコードには、特殊なテクニックを使っています。おそらく、#2さんほどには速くないはずです。しかし、列数の可変が利きます。

'//
Sub TestArray2()
Dim a, b, x, i As Long, j As Long
Const COL As Integer = 3　'列数の設定
　For i = 1 To COL
　 x = x & "," & i
　Next i
　x = Split(Mid(x, 2), ",")
　a = Range("A2", Cells(Rows.Count, 1).End(xlUp).Offset(, COL)).Value
　ReDim b(1 To UBound(a, 1), 1 To 1)
　ReDim c(1 To UBound(a, 1), 1 To UBound(a, 2))
　j = 1
　For i = LBound(a, 1) To UBound(a, 1) - 1
　　 If a(i, 1) <> a(i + 1, 1) Then
　　　 b(j, 1) = i
　　　　j = j + 1
　　 ElseIf a(i, 1) = a(i + 1, 1) Then
　　　 a(i, 3) = a(i, 3) + a(i + 1, 3)
　　　 b(j, 1) = i
　　　 i = i + 1: j = j + 1
　　 End If
　Next
　c = Application.Index(a, b, x)
　Application.ScreenUpdating = False
　Range("A2").Resize(i, 3).ClearContents
　Range("A2").Resize(j - 1, COL).Value = c
　Application.ScreenUpdating = True
End Sub

layy · Answer

終わりの
Application.ScreenUpdating = TRUE
かな？。

削除する行が決まれば、そこにマークしておいて、
削除マークで並べ替えなりフィルタすれば一気に削除。

「削除」「再描画表示」
こういうのが遅くしている可能性あります。

エクセルの行の削除を配列で高速化したい

試してみて

>このような質問方法はルールに反しているのでしょうか？

前述のは、

最初、直接の回答ではありませんので読み捨てしていただいて良いのですが、少し私の考え方を言わせてもらいます。

終わりの

似たような質問が見つかりました

このQ&Aを見た人はこんなQ&Aも見ています

関連するカテゴリからQ&Aを探す

このQ&Aを見た人がよく見るQ&A

デイリーランキングこのカテゴリの人気デイリーQ&Aランキング

マンスリーランキングこのカテゴリの人気マンスリーQ&Aランキング