エクセル 同じ文字を自動消去

質問

エクセルのメールアドレス一覧表があるのですが
同じメールアドレスが複数がある時、一つづつ消すのは
時間がかかり大変です。自動検索して自動消去する方法はないでしょうか？

回答No.10

kazuhiko5681 · ベストアンサー

こんばんわ。まだ、解決していないみたいですね。
ちょっと面倒かもしれませんが、Ａ１に適当な文字(アルファベットでも数字でも何でもよい)を１文字入れてエンターキーを押した時に行が削除できるようにマクロを組んでみました。１行目は、空白行として下さい。次のように操作します。

１．データの入力されているブックを開き、ＡＬＴ＋Ｆ１１キーを押してＶＢＥ画面を表示する。
２．画面左上にあるVBEProjectと書いてある下のSheet1をダブルクリックし、右側の白い部分に下記のコードをコピー・ペーストする。
３．再びＡＬＴ＋Ｆ１１キーを押してエクセルの画面にもどる
４.Ａ１に適当な文字を１文字入力するとマクロが動作する。

このマクロはＡ１とＡ２が同じ・Ｂ１とＢ２が同じ・Ｃ１とＣ２が同じであった時、２行目のデータを削除するようにしてあります。
もし、うまく動作しなかった場合には、VBAProjectの下にブックに挿入されているシートの枚数文(例えばシートが３枚あったとしたらShet1・Sheet2・Sheet3)コードエディタがあります。Sheet2・Sheet3もそれぞれダブルクリックしてそれぞれのコードエディタに同じようにコードを貼り付けて実行してみて下さい。こちらでは確認済みなので多分今度は動作すると思います。
お手数をおかけいたしますが、よろしくお願いいたします。

Private Sub Worksheet_Change(ByVal Target As Range)

Dim myRow As Integer
Dim i As Integer
Dim j As Integer
Dim k As Integer
Dim myCnt As Integer

If Target.Address = "$A$1" Then
Application.EnableEvents = False
myRow = Cells(Rows.Count, 1).End(xlUp).Row
For i = 1 To myRow - 1
If Cells(i, 1).Value <> "" Then
For j = i + 1 To myRow
For k = 1 To 3
If Cells(i, k).Value = Cells(j, k).Value Then
myCnt = myCnt + 1
If myCnt = 3 Then
Rows(j & ":" & j).ClearContents
End If
End If
Next k
myCnt = 0
Next j
End If
Next i

Do
myRow = Cells(Rows.Count, 1).End(xlUp).Row
If Cells(myRow, 1).End(xlUp).Row = 1 Then Exit Do
For i = 2 To myRow
If Cells(i, 1).Value = "" Then Rows(i & ":" & i).Delete
Next i
Loop
Application.EnableEvents = True
End If

End Sub

前回アクセスキーを使ってマクロを実行させようとしましたが、うまく動かなかったので、コマンドボタンで実行させる方法もご紹介しておきます。この方法を実行するには、次のように操作して下さい。

１.データが入力されているシートを開く。
２.メニューバーにマウスポインターを合わせて右クリック
３.出てきたプルダウンメニューのVisualBasicをクリック
４.出てきたツールバーのかなづちとスパナのマーク(コントロールツールボックス)をクリック
５.出てきたツールバーの一番右端の上から２番目(コマンドボタン)をクリックし、配置したい位置にマウスポインターを合わせクリックする。
６.配置されたコマンドボタンをダブルクリックするとＶＢＥ画面になり、コードエディターに自動的に
Private Sub CommandButton1_Click()
　　ここに下のコードをコピー・ペーストする。
End Sub
と表示される。

Dim myRow As Integer
Dim i As Integer
Dim j As Integer
Dim k As Integer
Dim myCnt As Integer

myRow = Cells(Rows.Count, 1).End(xlUp).Row
For i = 1 To myRow - 1
If Cells(i, 1).Value <> "" Then
For j = i + 1 To myRow
For k = 1 To 3
If Cells(i, k).Value = Cells(j, k).Value Then
myCnt = myCnt + 1
If myCnt = 3 Then
Rows(j & ":" & j).ClearContents
End If
End If
Next k
myCnt = 0
Next j
End If
Next i

Do
myRow = Cells(Rows.Count, 1).End(xlUp).Row
If Cells(myRow, 1).End(xlUp).Row = 1 Then Exit Do
For i = 2 To myRow
If Cells(i, 1).Value = "" Then Rows(i & ":" & i).Delete
Next i
Loop

もし、変更点・ご不明な点がございましたらご遠慮なくお知らせ下さい。

補足

本当にありがとうございます
試してみます　また結果報告しますので
その時はどうぞよろしくお願い致します

回答No.9

taisuke555

もう１つ質問です。

今現在、どのような事をしているのでしょうか？

例えば、A1セルに手入力で、アドレスを入力しているとすれば、
A1セルに入力後、直ぐに（マクロを実行する為のボタンなどを押さないで）
行を削除するマクロを作る事も出来ます。

もう少し今現在、行っている様子がわかると、A1,B1,C1と入力しないでも
A1のみで、処理することも可能かと思いますので、少し細かい所を教えて頂ければと思います。

回答No.8

taisuke555

＃５の補足について
もう少し具体的に教えて頂けますか？

１行目(A1,B1,C1・・・)に入力したアドレスをA2～A?までを検索し、重複した行を削除する
ということでよろしいのでしょうか？

回答No.7

kazuhiko5681

こんばんわ。マクロダイアログボックスは表示されたとのことですが、そのボックスの右下にあるオプションボタンをクリックしてカーソルが点滅しているところに半角小文字でeと入力してＯＫボタンをクリックして×ボタンでダイアログボックスを閉じていますよね。それからCTRL+eを押すと砂時計が出てきて画面の変化がないということでよろしいのでしょうか。
あなた様はEと大文字でかかれていますが、大文字で入力してしまったということはないですか。もし大文字で入力してしまったのであれば、ctrl+Shift+eキーを同時に押すと動くと思います。
これで動かなかった時は、再度お知らせ下さい。
お手数をおかけいたしますが、よろしくお願いいたします。

補足

返事遅れてすいません。私の説明、誤解不足でよく
見てみるとアドレスはA1,A2,A3,A4,A5・・・・のように
並んでいました。ひょっとしてこれが原因でしょうか？
大変失礼致しました

回答No.6

kazuhiko5681

こんばんわ。ワードでは動かないと思います。エクセルで再度実行してみてください。
この時の確認なのですが、ＡＬＴ＋Ｆ８キーを押した時にマクロダイアログボックスが表示されますでしょうか。
私はエクセル９７を使ったことがないので、もしかしたらダイアログボックスが表示されないかもしれません。ダイアログボックスが表示されない場合は、お知らせ下さい。別の操作方法をご紹介したいと思います。

お手数をおかけいたしますが、よろしくお願いいたします。

補足

はい　問題なくマクロダイアログボックスが表示されました

回答No.5

taisuke555

＃４さんへ
ちょっとマクロを見て思った事を２点あげさせてください。
（１）メールアドレスの重複チェックは、Ａ１セルのみ対象でよいのでしょうか？
　　　これは、質問者への補足質問になるのかな？
（２）このマクロだと、同じメールアドレスが２行並んでいると片方しか削除されないとおもいます。
　　　そのような状況が無ければ問題はないでしょうけど。

補足

お忙しい所すみません
マクロを作っていただく事は可能でしょうか？
A１セルのみ対象ではなくA1,B1,C1,,,,を対象にしたいのですが。。。可能でしょうか？

回答No.4

kazuhiko5681

早速補足いただきまして有難うございます。サンプルマクロを作ってみました。下記のように操作してみて下さい。

１．データの入力されているブックを開き、ＡＬＴ＋Ｆ１１キーを押してＶＢＥ画面を表示する。
２．画面左上にあるVBEProjectと書いてある下のSheet1をダブルクリックし、右側の白い部分に下記のコードをコピー・ペーストする。
３．再びＡＬＴ＋Ｆ１１キーを押してエクセルの画面にもどる
４．ＡＬＴ＋Ｆ８キーを押してマクロダイアログボックスを表示させ、右のオプションをクリックして、カーソルが点滅しているところに小文字でeと入力し、ＯＫボタンをクリックする。その後×ボタンでマクロダイアログボックスを閉じる。

ＣＴＲ＋eを押してみてください。マクロが実行されて削除されているのがお解りいただけると思います。

Sub Test1()

Dim myRange As Range

For Each myRange In Range("A2:" & Cells(Rows.Count, 1).End(xlUp).Address)
If myRange.Value = Range("A1").Value Then
myRange.EntireRow.Delete shift:=xlShiftUp
End If
Next

End Sub

もし、不都合なことがありましたらご遠慮なくお知らせ下さい。

補足

ありがとうございます
そっそく試してみましたが、CTR＋Eを押すと砂時計がでて
何か処理をしようとしているのですが、何も変化がありません　WORD９７が原因なんでしょうか？

回答No.3

imogasi

（１）関数式で、自分や他行を削除することは出来ないと思います。（（３）のようにソートを使う一部に関数式を
使うのは別として）
（２）ダブっている行を色づけし、削除する手間と正確性を
図ることは出来ます。
Ａ．ダブリを考えている列(仮にＡ列とする）の最下行まで範囲を指定。
Ｂ．書式－条件付き書式－左のボックスで▼をクリックして「数式が」を出す。右のボックスに=countif(a:a,a1)>1と入力
する。
Ｃ．「書式」をクリック。
Ｄ．「パターン」タブをクリック。色を選ぶ。ＯＫクリック。
Ｅ．ダブった行は、色がつくから上から、行削除していく。
　　削除でダブりが解消されると１つ残った行の色が消える。
（３）別法
ソートしても良いならＡ列でソートする。Ｂ列に列挿入する。
Ａ１はデータなしとする。Ｂ２に関数式=IF(A2=A1,"",A2)をいれる。Ｂ列最下行まで複写。Ｂ列にＢ列を値複写。Ｂ列でソートする。上部のＢ列の空白部を範囲指定して、行削除する。
アドレスとして働かなくする必要があれば、働かないようにしてから上記を行ってください。

回答No.2

mneko

メニューバーの「データ」－＞「フィルタ」－＞オートフィルで
メールアドレスの項目で（列）重複データ（特定の）を選択して
その重複データだけを表示させて行削除そすれば良いと思います。

回答No.1

kazuhiko5681

はじめまして。
マクロを書けば簡単にできると思います。
もしご希望でしたらサンプルマクロを作ってみたいと思いますので次のことをお知らせ下さい。

１．メールアドレスが入っているセル番地とシートの名前(Sheet1,Sheet2等シートタブについている名前)

お手数をおかけいたします。よろしくお願いいたします。

補足

本当に助かります　ぜひお願い致します

セル番地はA1
シートは1です

ちなみに環境はエクセル９７です