Excel VBA質問箱 IV

当質問箱は、有志のボランティア精神のおかげで成り立っています。
問題が解決したら、必ずお礼をしましょうね。
本サイトの基本方針をまとめました。こちら をご一読ください。

投稿種別の選択が必要です。ご注意ください。
迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。


4386 / 13646 ツリー ←次へ | 前へ→

【56961】重複行の削除 勉強中さっち 08/7/15(火) 11:05 質問[未読]
【56962】Re:重複行の削除 kanabun 08/7/15(火) 11:30 発言[未読]
【56964】Re:重複行の削除 勉強中さっち 08/7/15(火) 11:52 お礼[未読]
【56976】Re:重複行の削除 kanabun 08/7/15(火) 23:51 発言[未読]
【56981】Re:重複行の削除 勉強中さっち 08/7/16(水) 9:41 質問[未読]
【56982】Re:重複行の削除 kanabun 08/7/16(水) 11:20 発言[未読]
【56983】Re:重複行の削除 勉強中さっち 08/7/16(水) 11:53 お礼[未読]
【56963】Re:重複行の削除 こぎつね 08/7/15(火) 11:30 発言[未読]
【56965】Re:重複行の削除 勉強中さっち 08/7/15(火) 11:53 お礼[未読]

【56961】重複行の削除
質問  勉強中さっち  - 08/7/15(火) 11:05 -

引用なし
パスワード
   こんにちわ。
早速ですがご教示の程宜しくお願い致します。

名前 点数
田中 50
田中 50
鈴木 60
鈴木 60
斉藤 55
田中 50
斉藤 55
斉藤 55
鈴木 60

重複している行を削除したいのですが、下記マクロだとうまくいきません。
Sub DeCol()
  Dim i As Long
  With Range("A2")
  
  For i = .CurrentRegion.Rows.Count To 1 Step -1
    If .Offset(i, 0) = .Offset(i - 1, 0) Then .Offset(i, _
    0).EntireRow.Delete
    Next i
  End With
End Sub


名前 点数
田中 50
鈴木 60
斉藤 55

となって欲しいのです。
ご教示ください。

【56962】Re:重複行の削除
発言  kanabun  - 08/7/15(火) 11:30 -

引用なし
パスワード
   ▼勉強中さっち さん:

>名前 点数
>田中 50
>鈴木 60
>斉藤 55
>
>となって欲しいのです。

下から、ひとつづつ上と比較して同じだったら下を削除していくには、
表をまず、ソートしておかないといけないです。

名前    点数
斎藤    55
斎藤    55
斎藤    55
鈴木    60
鈴木    60
鈴木    60
田中    50
田中    50
田中    50

つぎに、If文を2重にして
外側のIf文で 名前の比較をして、
  名前が上下同じときのみ、内側の 点数を比較して、
   同じ点数のときのみ、行削除する
  End If
End If

てな感じにします。

【56963】Re:重複行の削除
発言  こぎつね  - 08/7/15(火) 11:30 -

引用なし
パスワード
   http://www.vbalab.net/vbaqa/c-board.cgi?word=%8Fd%95%A1&way=0&target=all&view=0&id=excel&cmd=src&x=37&y=14
”重複”で検索してみました。

【56964】Re:重複行の削除
お礼  勉強中さっち  - 08/7/15(火) 11:52 -

引用なし
パスワード
   ▼kanabun さん:


>下から、ひとつづつ上と比較して同じだったら下を削除していくには、
>表をまず、ソートしておかないといけないです。
>
>名前    点数
>斎藤    55
>斎藤    55
>斎藤    55
>鈴木    60
>鈴木    60
>鈴木    60
>田中    50
>田中    50
>田中    50
>
ありがとうございます!
まず、ソートを勉強致しますW

ソートせずにA列にある重複した行を一撃で削除する方法もあるのでしょうか。
ヒントくださいませ。

【56965】Re:重複行の削除
お礼  勉強中さっち  - 08/7/15(火) 11:53 -

引用なし
パスワード
   ▼こぎつね さん:
>http://www.vbalab.net/vbaqa/c-board.cgi?word=%8Fd%95%A1&way=0&target=all&view=0&id=excel&cmd=src&x=37&y=14
>”重複”で検索してみました。

ありがとうございます!!
自分にあってるやつを探してみます。

【56976】Re:重複行の削除
発言  kanabun  - 08/7/15(火) 23:51 -

引用なし
パスワード
   ▼勉強中さっち さん:
>ソートせずにA列にある重複した行を一撃で削除する方法もあるのでしょうか。

あります。
ありますが、まず、ご自分でメンテできる 上の方法を習得されることを
おすすめします。
たとえば、現在は(ソートした後)下から順に一つ上と比較して
同じだったら、すぐ、行削除してますが、
毎回削除するのではなく、最後にまとめて削除するように改良するだけでも
格段の進歩ですよ (^^

【56981】Re:重複行の削除
質問  勉強中さっち  - 08/7/16(水) 9:41 -

引用なし
パスワード
   ▼kanabun さん:
>▼勉強中さっち さん:
>>ソートせずにA列にある重複した行を一撃で削除する方法もあるのでしょうか。
>
>あります。
>ありますが、まず、ご自分でメンテできる 上の方法を習得されることを
>おすすめします。
>たとえば、現在は(ソートした後)下から順に一つ上と比較して
>同じだったら、すぐ、行削除してますが、
>毎回削除するのではなく、最後にまとめて削除するように改良するだけでも
>格段の進歩ですよ (^^

そうですね。
まとめて削除するなら、削除行をまとめる入れ物作成して、最終的に
入れ物.DELETEとすれば、いけますよね。
配列を設定して、ReDim Preserveで格納されている削除行を失わなければ
最終的に一撃で削除できますよね?

その方が、処理速度があがるのでしょうか?

【56982】Re:重複行の削除
発言  kanabun  - 08/7/16(水) 11:20 -

引用なし
パスワード
   ▼勉強中さっち さん:
>>毎回削除するのではなく、最後にまとめて削除するように改良するだけでも
>>格段の進歩ですよ (^^
>
>そうですね。
>まとめて削除するなら、削除行をまとめる入れ物作成して、最終的に
>入れ物.DELETEとすれば、いけますよね。
>配列を設定して、ReDim Preserveで格納されている削除行を失わなければ
>最終的に一撃で削除できますよね?
>
>その方が、処理速度があがるのでしょうか?


スピード実験してみました

テストは 「Org」という5100行×8列 の表の入ったシートを、コピーして
コピーシートの方で、方法による処理スピードをテストしたものです。

'まず、下から対象行を一行づつ削除する方法
Sub Test1_Del_OnDemand()
  
  '範囲をソートする
  Worksheets("Org").Copy After:=Sheets(Sheets.Count)
  Range("A1").CurrentRegion.Sort Key1:=[A2], Key2:=[B2], Header:=xlYes
  
  Dim t!: t = Timer
  Dim rr As Range
  Dim i As Long, k As Long
  Dim LastRow As Long
  Dim v
  Application.ScreenUpdating = False '/ True
  LastRow = [A65536].End(xlUp).Row
  v = Range("A1:B" & LastRow).Value2
  For i = LastRow To 2 Step -1
    If v(i - 1, 1) = v(i, 1) Then   'A列が上下同じデータで、
      If v(i - 1, 2) = v(i, 2) Then  'かつ、B列も上下同じなら、
         Rows(i).Delete      'ただちに 行削除を実行
         k = k + 1
      End If
    End If
  Next
  Application.ScreenUpdating = True
  Debug.Print "'DEL_onDemand "; Timer - t; " ("; k; "行Delete"
End Sub
'この方法ですと、
Application.ScreenUpdating = False '/ True で画面の更新制御をすると
しないとでは、処理スピードに大きなさがあります。

  'DEL_onDemand 84.08594 秒 ( 5000 行Delete---- ScreenUpdatingなし
  'DEL_onDemand 19.78516  ( 5000 行Delete ----ScreenUpdating付き

'この方法しかないときは、Application.ScreenUpdating = False '/ True
による画面更新の抑止は必須です。
しかし、もともとApplication.ScreenUpdating = False '/ True の効果が
おおきいプログラムは シートにそれほど頻繁にアクセスしているという
ことです。セルへのアクセスは極力抑えたコードを書き、
Application.ScreenUpdating = False '/ True を使わなくても処理が効率
よく遂行されるようなコーディングに心がけましよう。


'Unionメソッドで 削除行を変数にまとめておき、最後に一括 行削除
Sub Test2_Union()
  
  '範囲をソートする
  Worksheets("Org").Copy After:=Sheets(Sheets.Count)
  Range("A1").CurrentRegion.Sort Key1:=[A2], Key2:=[B2], Header:=xlYes
  
  Dim t!: t = Timer
  Dim rr As Range
  Dim i As Long
  Dim LastRow As Long
  Dim v
  LastRow = [A65536].End(xlUp).Row
  v = Range("A1:B" & LastRow).Value2
  For i = LastRow To 2 Step -1
    If v(i - 1, 1) = v(i, 1) Then   'A列が上下同じデータで、
      If v(i - 1, 2) = v(i, 2) Then  'かつ、B列も上下同じなら、
                       '削除行を変数に格納
        If rr Is Nothing Then
          Set rr = Rows(i)
        Else
          Set rr = Union(rr, Rows(i))
        End If
        
      End If
    End If
  Next
  Debug.Print "'UnionRows "; Timer - t
  If Not rr Is Nothing Then
    rr.Delete
  End If 
End Sub
 
こちらの環境では、'UnionRows 0.2851563秒 でした。

【56983】Re:重複行の削除
お礼  勉強中さっち  - 08/7/16(水) 11:53 -

引用なし
パスワード
   ▼kanabun様
ご回答ありがとうございます。

ご返信にはお時間がかかるかと思います。
理解できるまでがんばります!(^0^;

4386 / 13646 ツリー ←次へ | 前へ→
ページ:  ┃  記事番号:
2610219
(SS)C-BOARD v3.8 is Free