エクセルで重複チェックをしたいと思っています。

完全一致の重複チェックではなく、一部が重複しているものも削除対象としたいのですが、何か良い方法はないでしょうか?

例)
http://aaaaa.jp/
http://aaaaa.jp/12345
http://aaaaa.jp/12345/00000
http://bbbbb.jp/
http://bbbbb.jp/123
http://bbbbb.jp/234
http://bbbbb.jp/345

というデータがあった場合

http://aaaaa.jp/
http://bbbbb.jp/

が残るようなやり方です。よろしくお願いします。

回答の条件
  • 1人3回まで
  • 登録:2009/03/20 19:00:37
  • 終了:2009/03/24 11:19:39

ベストアンサー

id:SALINGER No.1

SALINGER回答回数3454ベストアンサー獲得回数9692009/03/20 20:05:20

ポイント50pt

セルにそれぞれデータが入っているとして、

アドレスの上の階層だけを残すような、前の部分に含まれたら削除するマクロです。

(そこら辺の仕様が違う場合は教えてください。)

重複チェックをしたい範囲を選択して実行してください。

Sub test()
    Dim r1 As Range
    Dim r2 As Range
    For Each r1 In Selection
        If r1.Value <> "" Then
            For Each r2 In Selection
                If r2.Value <> "" And r1.Address <> r2.Address And _
                    InStr(1, r2.Value, r1.Value) = 1 Then
                    r2.Value = ""
                End If
            Next
        End If
    Next
End Sub
id:res01

私の説明がわかりにくかったようですみません。

http://aaaaa.jp/bbbbb/ccccc というURLがあったとして、

重複チェックの対象は「aaaaa.jp」の部分です。この部分で重複していた場合は

それ以降がどういう文字列であろうと重複対象とみなして削除するというものを

求めていました。

組んでいただいたマクロを利用させてもらったのですが、一部ドメインで重複した

ものが残ってしまっていました。

2009/03/22 21:24:04

その他の回答(5件)

id:SALINGER No.1

SALINGER回答回数3454ベストアンサー獲得回数9692009/03/20 20:05:20ここでベストアンサー

ポイント50pt

セルにそれぞれデータが入っているとして、

アドレスの上の階層だけを残すような、前の部分に含まれたら削除するマクロです。

(そこら辺の仕様が違う場合は教えてください。)

重複チェックをしたい範囲を選択して実行してください。

Sub test()
    Dim r1 As Range
    Dim r2 As Range
    For Each r1 In Selection
        If r1.Value <> "" Then
            For Each r2 In Selection
                If r2.Value <> "" And r1.Address <> r2.Address And _
                    InStr(1, r2.Value, r1.Value) = 1 Then
                    r2.Value = ""
                End If
            Next
        End If
    Next
End Sub
id:res01

私の説明がわかりにくかったようですみません。

http://aaaaa.jp/bbbbb/ccccc というURLがあったとして、

重複チェックの対象は「aaaaa.jp」の部分です。この部分で重複していた場合は

それ以降がどういう文字列であろうと重複対象とみなして削除するというものを

求めていました。

組んでいただいたマクロを利用させてもらったのですが、一部ドメインで重複した

ものが残ってしまっていました。

2009/03/22 21:24:04
id:maakunh No.2

maakunh回答回数35ベストアンサー獲得回数22009/03/21 23:40:19

ポイント10pt

この例に限っていえば、

以下の操作をExcelマクロで実現できそうです。

1.各セルの文字数を取得

2.1で取得した文字数で昇順にソート

3.1番目のデータをキーに2番目以降のデータをキーの文字数分Left関数で取り出し、キーと同じなら削除してシフト(列並びなら上方向にシフト)、という操作を最後のデータまで続ける

4.以降同様に、n番目のデータをキーにしてn+1番目以降の~最後のデータまで続け、これを最後のデータの一つ手前のデータがキーになるまで繰り返す

5.4が全て終わると例のようなものだけが残ります

ただし、文字列の途中に同じものがある場合は適用できません。

id:res01

すみません。

私はマクロを組んだことがないので、どのように組めばよいかわからないです。。。

2009/03/22 21:24:50
id:maakunh No.3

maakunh回答回数35ベストアンサー獲得回数22009/03/22 22:41:31

ポイント50pt

あまりきれいではないですが、とりあえず以下のやり方でできます。


Sub test()

Dim i, j

Dim strKey

'URLのある列をソート(A列)

Columns("A:A").Select

Selection.Sort Key1:=Range("A1"), Order1:=xlAscending

i = 1

Do

'キーとなるセルを設定

strKey = Cells(i, 1).Value

j = i + 1

Do

'キーのセル値と比較セル値のキーセル値の文字数分を比較し同じなら、比較セルを削除sし上方向へシフト

If strKey = Left(Cells(j, 1).Value, Len(strKey)) Then

Cells(j, 1).Delete Shift:=xlUp

j = j - 1

End If

'最後まで比較し終わったらこの処理は終了

If Cells(j, 1).Value = "" Then

Exit Do

End If

j = j + 1

Loop

'全て比較し終わったら全処理終了

If Cells(i, 1).Value = "" Then

Exit Do

End If

i = i + 1

Loop

End Sub


id:res01

ありがとうございます。

組んでいただいたマクロを試させて頂いたのですが、SALINGER様の最初の回答と同様に

トップレベルドメイン(http://aaaa.jp/の部分)以下にディレクトリやパラメーターがついている場合に

トップレベルドメインで重複したものが残ってしまいました。

2009/03/23 22:23:51
id:kia_44 No.4

きあ回答回数396ベストアンサー獲得回数302009/03/23 01:42:15

ポイント30pt

手作業の方針で


参考URL

http://blog.goo.ne.jp/poco0704/e/fe145cd1d17fd305815405be57f604d...

http://aaaaa.jp/

http://aaaaa.jp/12345

http://aaaaa.jp/12345/00000

http://bbbbb.jp/

http://bbbbb.jp/123

http://bbbbb.jp/234

http://bbbbb.jp/345

この場合、「/」でセルを分割

その後、隣のセルにでも必要な部分のみを文字列結合。(&を使うやつ)

その後ピボットテーブルにかけます。

www.が入る場合もあるのであれば、www.は置換で消しちゃえばいいかと。


ごめんなさい。今手元にエクセルがないので試してません・・・。

id:res01

ありがとうございます。

文字列の分割がマクロなしで出来ることを知らなかったので勉強になりました。

ドメイン以下のゴミ取り作業に利用させてもらいます。

2009/03/23 22:26:19
id:tap_t No.5

たっぷ回答回数45ベストアンサー獲得回数62009/03/23 17:45:30

ポイント30pt

他の人の回答とかぶりそうですが・・・

説明するとやっかいそうですが、やってみれば簡単です。

前提

1. 一致する必要があるのは "http://aaaaa.jp/"の箇所であるとします。

2. 最終的に残す部分も 1 と同様とします。

3. 一致に際しては、一致する分でソートされているものとします。

4. Excel2000にての手順とします。

手順

※例題を元にします。

1. 例題を全て A1 を基準にして貼り付ける

2. シート全体を選択して、A列でメニューの「データ」->「並べ替え」を選択して「最優先されるキー」が列Aになっていることを確認して「OK」を押下

3. A列を選択してメニューの「データ」->「区切り位置」を選択して区切り位置指定ウィザードを表示

4. 「カンマやタブなど・・・」を選択して「次へ」ボタン押下

5. 「区切り文字」のその他のところに "/" を入力して「次へ」ボタン押下。次の画面で「完了」ボタン押下。これで、"/"で分解される。

6. A列を選択して右クリックメニューより挿入を選択

7. 挿入した A列のA1セルに、=B1&"//"&D1&"/" を入力

8. A1列をデータの最終行まで、フィル(セルの右下の辺りをつかんで下に引っ張る)で入力

9. A列を選択して右クリックメニューより挿入を選択

10. A1セルに 0 を入力

11. A2セルに =IF(B1=B2,1,0) を入力

12. A2セルをデータの最終行までフィルで入力。この時点で、重複している行が 1、重複していない行が0になる。

13. A列を選択して右クリックメニューより挿入を選択

14. B列を選択して右クリックメニューよりコピー

15. A列を選択して右クリックメニューの「形式を選択して貼り付け」を選択

16. 「貼り付け」の「値」を指定して「OK」ボタンを押下

17. シート全体を選択して、A列でメニューの「データ」->「並べ替え」を選択して「最優先されるキー」が列Aになっていることを確認して「OK」を押下。この時点で、重複していない行のみが先頭の方にソートされる。

18. 上から、先頭が 0 のものが重複なしの行なので、不要な部分を削除する。

もうちょっと、簡略出来そうですが、まぁこんな感じです。

id:res01

詳細な回答ありがとうございます。

マクロ無しでもなんとかなるものですね。とても参考になりました。

2009/03/23 22:29:56
id:SALINGER No.6

SALINGER回答回数3454ベストアンサー獲得回数9692009/03/23 18:17:00

ポイント400pt

仕様としてはこんな感じになるでしょうか。

「URLで最初の階層が一致するものがあれば先に出てきたものを残す」

その仕様で最初の回答を変更してみます。

Sub test()
    Dim r1 As Range
    Dim r2 As Range
    For Each r1 In Selection
        If r1.Value <> "" Then
            For Each r2 In Selection
                If r2.Value <> "" And r1.Address <> r2.Address And _
                    StrSep(r2.Value) = StrSep(r1.Value) Then
                    r2.Value = ""
                End If
            Next
        End If
    Next
End Sub

Function StrSep(str As String) As String
    Dim i As Integer
    i = InStr(1, str, "://")
    If i > 0 Then
        StrSep = Left(str, InStr(i + 3, str, "/"))
    Else
        StrSep = ""
    End If
End Function

(細かい点を確認できるように、コメント欄をオープンされることをお勧めします。)

id:res01

ありがとうございます。

重複削除において、私が予想していた通りの動作を確認しました。

ついでというわけではないのですが、このマクロの中に以下の処理を加えていただけないでしょうか?

・全てのURLにおいて、ドメインより下層のURL(http://aaaaa.jp/○○○の○部分以下のパラメーター全て)を消去する。

この処理が加わると、私の求めている仕様を100%満たすことになります。

もしよろしかったらお願いします。

2009/03/23 22:46:05
  • id:SALINGER
    r2.Value = ""
    の下に
    r1.Value = StrSep(r1.Value)
    を追加してください。
  • id:res01
    >SALINGER様
    予想していた動作になりました。
    ありがとうございます。


    皆様ありがとうございました。
    お陰様で作業効率がかなり上がり、エクセルの勉強にもなりました。
    いるか賞を間違って違う場所につけてしまったのが心残りではありますが
    これにて〆させていただきます。

この質問への反応(ブックマークコメント)

「あの人に答えてほしい」「この質問はあの人が答えられそう」というときに、回答リクエストを送ってみてましょう。

これ以上回答リクエストを送信することはできません。制限について

絞り込み :
はてなココの「ともだち」を表示します。
回答リクエストを送信したユーザーはいません