Excelで、


りんご/あああ/いいい/ううう/
りんご/あああ/いいい/ううう/
りんご/あああ/いいい/ううう/
みかん/えええ/おおお/かかか/
みかん/えええ/おおお/かかか/
みかん/えええ/おおお/かかか/

(/はセルの区切り。単語ごとにセルに入っています。)

というようにダブっている行を、

りんご/あああ/いいい/ううう/
みかん/えええ/おおお/かかか/

というように、1つにまとめられる方法をご存知の方いらっしゃいましたら教えてください。
なおダブりは最高で40行程、全体で2000行近く、また横のセルは最高で26行あります。

回答の条件
  • 1人2回まで
  • 登録:2008/07/17 15:47:40
  • 終了:2008/07/18 13:07:55

回答(7件)

id:kn1967 No.1

kn1967回答回数2915ベストアンサー獲得回数3012008/07/17 15:51:22

ポイント15pt

バージョンによって多少違いがありますので

Microsoft製品に関するご質問には必ずバージョンを明記なさるようにお願いします。

とりあえずですが下記、Excel2002/Excel2003の場合です。

http://office.microsoft.com/ja-jp/excel/HA010346261041.aspx

id:sapporobeer

バージョンの件は、すみませんでした。2003です。

あと、早速のご回答ありがとうございます。

2008/07/17 17:24:15
id:fuentebella No.2

fuentebella回答回数269ベストアンサー獲得回数302008/07/17 16:04:24

ポイント15pt

単なる行の重複なら

「Excel のリストから重複する行を削除する」

http://office.microsoft.com/ja-jp/excel/HA010346261041.aspx

でできます。


もし

りんご/あああ/いいい/ううう/

りんご/いいい/あああ/ううう/

も同じとみなすならこの方法ではできません。

id:sapporobeer

あぁ・・・そうですか・・・。

実は、

りんご/あああ/いいい/ううう/

りんご/いいい/あああ/ううう

のパターンなんですよ。

ありがとうございました。

2008/07/17 17:25:14
id:beatgoeson No.3

beatgoeson回答回数128ベストアンサー獲得回数142008/07/17 16:10:05

ポイント15pt

1行目にヘッダがあるとして(なければ適当につけてください)

[データ]->[フィルター]->[フィルターオプションの指定] で、「重複するレコードは無視する」にチェックをいれて[OK]

重複が解消されるので、それをコピー&ペーストで別のシートに貼り付けてればできると思います。

http://www11.plala.or.jp/koma_Excel/contents6/m

id:sapporobeer

ありがとうございます。

2008/07/17 17:25:56
id:taknt No.4

きゃづみぃ回答回数13537ベストアンサー獲得回数11982008/07/17 16:11:39

ポイント15pt

VBAじゃないと 難しいですね。

VBAを使って作ってみました。

Sub 重複チェック()

    tr = Range("A65536").End(xlUp).Row

    For a = tr To 2 Step -1
        For b = tr - 1 To 1 Step -1
            f = 1
            For c = 1 To Range("IV" & a).End(xlToLeft).Column
               If Cells(a, c) <> Cells(b, c) Then f = 0: Exit For
            Next c
            If f = 1 Then Rows(b).ClearContents
        Next b
    Next a
    
    For a = tr To 2 Step -1
        If Cells(a, 1) = "" Then Rows(a).Delete Shift:=xlUp
    Next a
End Sub
id:sapporobeer

ありがとうございます。

2008/07/17 18:18:52
id:takepierrot No.5

takepierrot回答回数52ベストアンサー獲得回数72008/07/17 16:12:03

ポイント16pt

僕なら、表をコピーしてテキストエディタに貼り付けて、マージ(重複行の削除)を行います。

サクラエディタなら、全選択してからalt+Mですね。で、マージが終わったら、もう一度全選択してコピー。それをエクセルに貼り付けます。

でも、関数使っていたら問題ある方法なのかもしれません。

なおサクラエディタでは、連続している重複行のみマージが行われます。秀丸エディタの場合は、マクロを使えば重複行が連続してなくてもマージできますが、シェアウェアですからねぇ。

サクラエディタ:http://members.at.infoseek.co.jp/sakura_editor/snapshot.html

id:sapporobeer

ありがとうございます。

2008/07/18 13:02:08
id:taknt No.6

きゃづみぃ回答回数13537ベストアンサー獲得回数11982008/07/17 16:18:02

ポイント15pt

先ほどの回答は、部分一致だと ダメでしたので 一部修正しました。

Sub 重複チェック()

    tr = Range("A65536").End(xlUp).Row

    For a = tr To 2 Step -1
        For b = a - 1 To 1 Step -1
            f = 1
            If Range("IV" & a).End(xlToLeft).Column <> Range("IV" & b).End(xlToLeft).Column Then f = 0
            For c = 1 To Range("IV" & a).End(xlToLeft).Column
               If Cells(a, c) <> Cells(b, c) Then f = 0: Exit For
            Next c
            If f = 1 Then Rows(b).ClearContents
        Next b
    Next a
    
    For a = tr To 1 Step -1
        If Cells(a, 1) = "" Then Rows(a).Delete Shift:=xlUp
    Next a
End Sub

これで

みかん/えええ/おおお/かかか/ああああ

みかん/えええ/おおお/かかか/

の二つの行を 別と判断します。

id:sapporobeer

わざわざありがとうございます。

2008/07/18 13:02:04
id:Mook No.7

Mook回答回数1312ベストアンサー獲得回数3912008/07/17 21:45:03

ポイント40pt

2番目の回答のコメントで、

>あぁ・・・そうですか・・・。

>実は、

>りんご/あああ/いいい/ううう/

>と

>りんご/いいい/あああ/ううう

>のパターンなんですよ。

とのことでしたのでデータの順序を問わず、内容が同じものの重複を省きたいという解釈をしました。


下記のコードを実行するとシートの先頭に1列挿入され、同じ内容の行には X +数字(同じ内容の行)が記入されます。

実行後A列でソートし、スペース以外の行を削除し、A列を削除すれば、目的の結果になると思います。


作業用のシートが作成されますが、実行後削除ください。

Option Explicit

Sub fuzzyMatching()
    Dim srcWS As Worksheet
    
    Set srcWS = ActiveSheet
    srcWS.Copy after:=Worksheets(Worksheets.Count)
    
    Dim tmpWS As Worksheet
    Set tmpWS = Worksheets(Worksheets.Count)
    
    srcWS.Columns(1).Insert
    
    Dim lastRow As Long
    Dim i As Long
    
    Application.ScreenUpdating = False
    lastRow = tmpWS.Range("A" & Rows.Count).End(xlUp).Row
    For i = 1 To lastRow
        tmpWS.Rows(i).Sort key1:=tmpWS.Range("A" & i), order1:=xlAscending, Orientation:=xlLeftToRight, ordercustom:=1
    Next
    srcWS.Activate
    Dim sr As Long, dr As Long
    Dim c As Long
    Dim colNum1 As Long, colNum2 As Long
    Dim blSame As Boolean
    For sr = 1 To lastRow
        If srcWS.Cells(sr, "A").Value = "" Then
            For dr = sr + 1 To lastRow
                If srcWS.Cells(dr, "A") = "" Then
                    colNum1 = tmpWS.Cells(sr, Columns.Count).End(xlToLeft).Column
                    colNum2 = tmpWS.Cells(dr, Columns.Count).End(xlToLeft).Column
                    If colNum1 = colNum2 Then
                        blSame = True
                        For c = 1 To colNum1
                            If tmpWS.Cells(sr, c).Value <> tmpWS.Cells(dr, c).Value Then
                                blSame = False
                                Exit For
                            End If
                        Next
                        If blSame Then srcWS.Cells(dr, "A").Value = "X " & sr
                    End If
                End If
            Next
        End If
        If sr Mod 20 = 0 Then
            Application.ScreenUpdating = True
            srcWS.Cells(sr, "A").Activate
            Application.ScreenUpdating = False
        End If
    Next
End Sub
id:sapporobeer

ありがとうございました。

ここまでしてくださり、非常にうれしく思います。

2008/07/18 13:03:43
  • id:Mook
    しまった。
    マクロの最後に(End Sub の直前に)
    Application.ScreenUpdating = True
    を追加してください。
  • id:taknt
    複数セルもフィルタで一発でできるんですね。
    知らなかった・・・。

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

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

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

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