質問をすることでしか得られない、回答やアドバイスがある。

15分調べてもわからないことは、質問しよう!

新規登録して質問してみよう
ただいま回答率
85.50%
VBA

VBAはオブジェクト指向プログラミング言語のひとつで、マクロを作成によりExcelなどのOffice業務を自動化することができます。

Q&A

解決済

2回答

2733閲覧

複数の項目が重複した古い方の列を削除

myunmomo

総合スコア5

VBA

VBAはオブジェクト指向プログラミング言語のひとつで、マクロを作成によりExcelなどのOffice業務を自動化することができます。

0グッド

0クリップ

投稿2020/01/07 02:47

引き継いだVBAで悩んでいます。
初心者なので皆さんお助け下さい。

エクセル2010で動かしてします。
前日のデータに当日のデータを下の段に足します。
が更新されたデータには前日と同じデータが存在します。
今まではE列のみ重複の場合でよかったのですが、
今回I列も重複している場合に変更になりました。
E列とI列が同じなら古い上段を削除したいです。

RemoveDuplicatesを使うと新しいデータが削除されてしまうので、
前任者は下記のようにしたのだと思います。
下記ですとI列が違ってもE列が同じなら、削除されます。
条件にE列I列共に同じ場合古い方を列ごと削除するのは
どうすればいいのでしょうか?
どうかお助け下さい。

Sub DataDelete()
Dim i As Long, rng As Range, EndRow As Long
Dim Hani As Range

EndRow = Range("E" & Rows.Count).End(xlUp).Row
For i = EndRow To 2 Step -1
Set Hani = Range(Range("E2"), Range("I" & i - 1))
For Each rng In Hani
If rng.Value = Range("I" & i) Then
rng.Interior.ColorIndex = 3
End If
Next rng
Next i
For i = EndRow To 2 Step -1
If Range("I" & i).Interior.ColorIndex <> xlNone Then
Range("E" & i).EntireRow.Delete
End If
Next i
End Sub

気になる質問をクリップする

クリップした質問は、後からいつでもMYページで確認できます。

またクリップした質問に回答があった際、通知やメールを受け取ることができます。

バッドをするには、ログインかつ

こちらの条件を満たす必要があります。

guest

回答2

0

上の方が残るなら、残したい方を上に持ってきては?

ExcelVBA

1Sub test() 2 Dim rngOld As Range '前日のデータのセル範囲 3 Dim rngNew As Range '最新のデータのセル範囲 4 5 Set rngOld = ThisWorkbook.Worksheets(1).Range("A1").CurrentRegion 6 Set rngNew = Workbooks(2).Worksheets(1).Range("A1").CurrentRegion 7 8 rngOld.Copy rngNew(rngNew.Rows.Count + 1, 1) 9 10 rngNew.CurrentRegion _ 11 .AdvancedFilter Action:=xlFilterCopy, _ 12 CopyToRange:=rngOld.Rows(1), _ 13 Unique:=True 14End Sub

投稿2020/01/07 08:58

mattuwan

総合スコア2136

バッドをするには、ログインかつ

こちらの条件を満たす必要があります。

myunmomo

2020/01/07 13:32

mattuwanさん ありがとうございました。 残したい方を上に持ってきてから削除してから、 日にち順にソートですよね。 すみません。 rngNew.CurrentRegion _ .AdvancedFilter Action:=xlFilterCopy, _ CopyToRange:=rngOld.Rows(1), _ Unique:=True がうまく動きません。 newの下にoldが貼りつきましたが、その後はどう動くのでしょうか?
guest

0

ベストアンサー

E列とI列が同じなら古い上段を削除したいです。

Dictionaryを使うとか、いろいろ方法は考えられますが、
現状のコードをなるべく活かすなら、下記のような感じでしょうか。

vba

1Sub DataDelete() 2 Dim i As Long, rng As Range, EndRow As Long 3 Dim Hani As Range 4 5 EndRow = Range("E" & Rows.Count).End(xlUp).Row 6 For i = EndRow To 3 Step -1 7 Set Hani = Range(Range("E2"), Range("E" & i - 1)) 8 For Each rng In Hani 9 If rng.Value = Range("E" & i) And rng.Offset(, 4).Value = Range("I" & i) Then 10 rng.Interior.ColorIndex = 3 11 End If 12 Next rng 13 Next i 14 For i = EndRow To 2 Step -1 15 If Range("E" & i).Interior.ColorIndex <> xlNone Then 16 Range("E" & i).EntireRow.Delete 17 End If 18 Next i 19End Sub

Dictionaryを使って重複チェックするコード例

vba

1Sub DataDelete2() 2 Dim d As Object 3 Set d = CreateObject("Scripting.Dictionary") 4 Dim EndRow As Long 5 EndRow = Range("E" & Rows.Count).End(xlUp).Row 6 7 Dim i As Long 8 For i = EndRow To 2 Step -1 9 If d.Exists(Cells(i, "E") & ";" & Cells(i, "I")) Then 10 Range("E" & i).EntireRow.Delete 11 Else 12 d(Cells(i, "E") & ";" & Cells(i, "I")) = i 13 End If 14 Next i 15End Sub

投稿2020/01/07 04:50

編集2020/01/07 06:52
hatena19

総合スコア33620

バッドをするには、ログインかつ

こちらの条件を満たす必要があります。

myunmomo

2020/01/07 06:40

hatena19さん ありがとうございます。 2行目と3行目にE列は重複しているが、I列は重複していないのに、 2行目の古い行が削除になりました。 どうしてでしょうか?
hatena19

2020/01/07 06:52

コードに間違いがありましたので修正しました。 もういちどコピーしなおして試してみてください。
myunmomo

2020/01/07 08:25

hatena19さん ありがとうございます。 2行目3行目は解決いたしました。 誠に申し訳ありませんが、並び替え削除の前にセルに色を付けることは可能でしょうか? 削除の前に検証が必要になりました。 削除されてはいけない重複データが発生しました。
hatena19

2020/01/07 09:46

前者のコードなら、後のループの部分を別にプロシージャに分割すれば、重複セルに色だけつきます。 削除てもいいかどうかをチェックしてから、よければ分割したプロシージャを実行すればいいでしょう。 後者のコードなら、EntireRow.Delete の部分を Interior.ColorIndex = 3 に変更すれば色がつきます。 削除は上記の分割したプロシージャを実行すればいいでしょう。
myunmomo

2020/01/07 13:12

hatena19さん ありがとうございます。 上手くいきました。 ありがとうございました。
guest

あなたの回答

tips

太字

斜体

打ち消し線

見出し

引用テキストの挿入

コードの挿入

リンクの挿入

リストの挿入

番号リストの挿入

表の挿入

水平線の挿入

プレビュー

15分調べてもわからないことは
teratailで質問しよう!

ただいまの回答率
85.50%

質問をまとめることで
思考を整理して素早く解決

テンプレート機能で
簡単に質問をまとめる

質問する

関連した質問