Excel (VBA)

Excel VBAに関するフォーラムです。
  • 掲示板への投稿には会員登録(無料)が必要です。会員登録がまだの方はこちら
  • 掲示板ご利用上のお願い」に反するご記入はご遠慮ください。
  • Q&A掲示板の使い方はこちらをご覧ください
トピックに返信
質問

 
(Windows 10全般 : Excel 2013)
ある条件に基づく、重複行削除について
投稿日時: 19/03/01 13:47:29
投稿者: ケイタ0505

A列とB列に同じものがある且つ、C列に9999/12/31以外がのものが入っている行
があったならば、
9999/12/31が入っている行を消すということをしたいです。
 
下記の処理を元に色々と試行錯誤したのですが、
9999/12/31以外があったならば9999〜を消す
という処理が分かりません。
 
dim i,lastrow
for i =lastrow to 1 step -1
 if cells(i,1) = cells(i-,1) and cells(i,2) = cells(i-,2)
  rows(i).delete
 end if
next i
 
どなたかお教えいただけると幸いです。
どうぞ宜しくお願い致します、
 
元データ(A1から入っております)
A0001 2017/11/6 9999/12/31
A0001 2017/11/6 2018/12/6
A0002 2019/1/24 9999/12/31
A0003 201812/12 9999/12/31
A0003 2018/12/12 2019/1/1
A0004 2019/1/1 9999/12/31
                         
行削除後
A0001 2017/11/6 2018/12/6
A0002 2019/1/24 9999/12/31
A0003 2018/12/12 2019/1/1
A0004 2019/1/1 9999/12/31

回答
投稿日時: 19/03/01 14:26:08
投稿者: Suzu

こんにちは。
 
A列、B列の 並び順は必ず 例の様に昇順で並んでいる保障があるのでしょうか?
 
 
正直に言うと、一般機能を使った方がかなり楽に削除できるのですが。。
D列とE列に、作業用列を用意します。
D列には、=A1&B1
E列には、=COUNTIFS($D:$D,D1)
 
そのうえで、オートフィルターを使い、
C列を、"9999/12/31"
E列を、2以上
で抽出し、その結果を削除すれば良いです。

投稿日時: 19/03/01 14:35:54
投稿者: ケイタ0505

ご回答ありがとうございます!
並び順においては、削除処理のfor next文の前に処理を入れたいと考えております。
そして、この削除はvbaでしたいと考えております。
と言いますのも、このようなシートを700シートほど繰り返さなければならず、
一般機能ではキリがないという現状です。。

回答
投稿日時: 19/03/01 14:49:10
投稿者: Suzu

Suzu さんの引用:
A列、B列の 並び順は必ず 例の様に昇順で並んでいる保障があるのでしょうか?

 
すみません。
 
A列、B列 は昇順
C列 を 降順
 
を条件に、
条件式に、
And Cells(i, 3) <> "9999/12/31" を追加すればよいでしょう。
 
 
ただし。。
・cells(i-,1) の様な書き方は、VBAでは許されてはいません。
  きちんと、cells(i-1,1) までいれてください。
 
・上記の前提で、 i が、1まで取ってしまうと、
   i=1 のとき、 Cells(i-1,1) は、Cells(0,1)となり、エラーとなります。
   i は、2 までとしましょう。
 
 
700シートですか。。
・1シートづつ並べ替え後、上記の様に全行を走査し削除する方法
・先に当方が示した部分を、マクロで処理してしまい、削除する方法
個人的には後者の方が速そうな気がします。。
 
1度きりの処理ではなく、年に何度も繰り返す様な処理なのであれば
どちらの方法をを採るのか処理速度のテストを行い決めた方が良いでしょうね。

回答
投稿日時: 19/03/01 16:23:56
投稿者: Suzu

なんとなく、、、
700シートもあるという事自体に問題がありそうな気もしますが。。サンプルです。
 
Sub sumple()
With Worksheets("Sheet5")
  '条件式設定
  .Range("D1").FormulaLocal = "=$A1 & $B1"
  .Range("E1").FormulaLocal = "=COUNTIFS(D:D,D1)"
  '条件式をオートフィルにて、最終行まで
  .Range("D1:E1").AutoFill Destination:=.Range(.Cells(1, 4), .Cells(.Cells(.Cells.Rows.Count, 1).End(xlUp).Row, 5))
 
  'オートフィルター使用準備
  '1行目に空白行挿入
  .Range("A1").EntireRow.Insert Shift:=xlDown
  'A1 に、col1 の列名設定
  .Range("A1").Formula = "col1"
  'A1からE1までオートフィルで列名設定
  .Range("A1").AutoFill Destination:=.Range(.Cells(1, 1), .Cells(1, 5))
 
  'オートフィルター設定
  With .Range("A1").CurrentRegion
    .AutoFilter Field:=5, Criteria1:=">1"
    .AutoFilter Field:=3, Criteria1:="9999/12/31", Operator:=xlAnd
  End With
 
' 行/列削除時のメッセージを抑制
' Excel.Application.DisplayAlerts = False
 
  'オートフィルター抽出された行のみ削除
  .Range("A1").CurrentRegion.SpecialCells(xlCellTypeVisible).Delete
  'D,E列削除
  .Range("D:E").Delete
 
' メッセージ抑制を解放。元に戻す
' Excel.Application.DisplayAlerts = True
End With
End Sub
 
700シートの部分は、ご自分でどうぞ。

投稿日時: 19/03/04 01:28:26
投稿者: ケイタ0505

お返事の方遅れてしまい申し訳ございません。
本日、教えて頂いた処理と、
複数ブックを開いて一気に処理する文を組み合わせて無事に出来ました!。
大変助かりました。
ありがとうございます。
また機会がありましたら、どうぞ宜しくお願い申し上げます。

トピックに返信