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

質問

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
と取り込んだあと、どう処理したらいいのかわかりません。
教えてください。

回答No.2

ki-aaa · ベストアンサー

試してみて

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

お礼

遅い時間にありがとうございました。
Sub 集計2()と同データで試してみましたところ大変なスピードで成功しました。
何と1秒ちょっとです！！
配列にての方法を今1行ずつ勉強しています。
タイトル行を含め一度配列ｖに取り込んで、2行目以降で条件に一致しないデータを別の配列ｖｖにいれて、次行データが条件に一致した場合だけ3列目のデータに加算しているのですね？

回答No.5

Wendy02

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

そうではなくて、車の運転で、横から、スロー・イン・ファースト・アウトを使ってとか、裏道があるから、そちらを使ってとか言われたら、行けると思うなら貴方が運転したら、と言われてしまうと思います。おまけに、#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

お礼

Sub TestArray2R()は期待通りの動きをしてくれました。
中身はぜんぜん解読できませんが何度もありがとうございます。

> 行けると思うなら貴方が運転したら、

そんな意地悪言わないでくださいな。
裏道知ってる人に「裏道で行ってみて、覚えたいから」ってよくお願いしますよ。

>　なぜ、ここまで出来て、自分自身で、配列でトライしないのか

配列にトライしたいから配列で高速化したいと質問したんじゃありませんか。
もちろん質問する前に、「行削除」、「高速化」などのキーワードで検索しましたよ。
それで配列を使った方が飛躍的に早いと知ったわけで・・・。
でも、自分で調べた範囲では、行や列の削除のようなことが配列でどうやれば出来るのか調べられなかったのです。
それで吉田兼好さんもおっしゃるように「何事にも先達はあらまほしきもの」と思い質問させていただきました。
今回はありがとうございます。

回答No.4

layy

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

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

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

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

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

お礼

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

はい、おかげさまで削除行にマークして並べ替えるという方位方を覚えました。
ありがとうございます。
勉強になりました。

回答No.3

Wendy02

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

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

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

#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

お礼

ご回答ありがとうございます。
配列ではない方法、ワークシートで実際に行を削除するやり方は質問に掲示したようにもうできていて、それではちょっと時間がかかりすぎるので配列を利用する方法を知りたいという質問でした。
#1さんのアドバイスを見て自分でコードを書き換えて時間は短縮できたのですが、それでもまだ遅かったのでまた「配列での方法を知りたいです」とお願いしたのです。
「配列」を使えば比較にならないくらい早くなるということは、このサイトや他の情報などで聞いておりましたから。
このような質問方法はルールに反しているのでしょうか？
であれば、回答者の方に「配列で高速化したい」などとわがままな書き方をしてしまい申し訳ありませんでした。

教えていただきましたSub TestArray2()を試してみました。
時間はやはり1秒ちょっとで早いのですが、結果が違いました。
特殊なテクニックとのことで解読できていませんが、結果から見るとB列の属性についての判定がされず、A列のID番号が上下で一致すれば下の行が削除されてしまうようです。

回答No.1

layy

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

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

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

お礼

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

なるほどと思いやってみました。

Sub 集計2()
Dim i As Long, r As Long
r = Cells(65536, 1).End(xlUp).Row
Application.ScreenUpdating = False
For i = 2 To r
Cells(i, 4) = i
If Cells(i, 1) = Cells(i - 1, 1) Then
If Cells(i - 1, 2) = "A" And Cells(i, 2) = "B" Then
Cells(i - 1, 3) = Cells(i, 3) + Cells(i - 1, 3)
Cells(i, 4).ClearContents
End If
End If
Next
Range(Range("A2:D2"), Range("A2:D2").End(xlDown)).Sort Key1:=Range("D2"), Order1:=xlAscending, Header:=xlNo, _
Orientation:=xlTopToBottom
Application.ScreenUpdating = True
End Sub

確かに早くはなりましたがそれでも30秒程度かかります。
配列での方法を知りたいです。