エクセルの指定部分数を超える重複チェックについて

質問

エクセルの指定部分数を超える重複チェックについて

例えばA列に以下の文章があったとします。

1.吾輩は猫である。名前はまだない。
2.吾輩は猫である。名前はもうある。
3.吾輩は犬である。名前はまだない。
4.吾輩は犬でない。名前はもうある。
5.本当に吾輩は猫である。名前はまだないかもしれない。

この中から、10文字以上【連続して】重複している箇所を探したい場合どうすれば良いでしょうか？

1～4で上記の条件に当てはまるのは
1と2の「吾輩は猫である。名前は」と、1と3の「である。名前はまだない。」と、1と5の「吾輩は猫である。名前はまだない」です。
2と4の「。名前はもうある。」も重複していますが、指定の文字数に達していないのでスルーさせたいです。

重複が見つかった場合の表示方法についてですが、重複している箇所がわかればどういう形で表示されても構いません。
ただ「重複の削除」のように、何が重複していたのかわからないまま削除されてしまうのは困ります。

回答No.5

mitarashi

徒然なるままにやってみました。testの方を実行して下さい。
B,C列に10文字以上の連続した重複がある文字列を表示し、該当箇所の文字に着色します。
お示しの例でしか試験してありませんので、安定動作の程は不明です。ご参考まで。

Sub test()
Dim targetRange As Range
Dim i As Long, j As Long, k As Long, l As Long, counter As Long
Dim searchWord As String, buf As String, shortStr As String, hitStr As String
Dim longStr As String
Const myColorIndex As Long = 3

Columns("B:C").Font.ColorIndex = 0
Columns("B:C").ClearContents
Set targetRange = Range(Range("A1"), Range("A" & Rows.Count).End(xlUp))
counter = 1
For i = 1 To targetRange.Cells.Count
For j = i + 1 To targetRange.Cells.Count
If Len(targetRange.Cells(i)) <= Len(targetRange.Cells(j)) Then
shortStr = targetRange.Cells(i)
longStr = targetRange.Cells(j)
Else
shortStr = targetRange.Cells(j)
longStr = targetRange.Cells(i)
End If
hitStr = ""
For k = 10 To Len(shortStr)
For l = 1 To Len(shortStr) - k + 1
searchWord = Mid(shortStr, l, k)
buf = Replace(longStr, searchWord, "")
If Len(buf) < Len(longStr) Then
hitStr = searchWord
Exit For
End If
Next l
Next k
If hitStr <> "" Then
Cells(counter, 2).Value = targetRange.Cells(i).Value
Cells(counter, 3).Value = targetRange.Cells(j).Value
test2 Cells(counter, 2), hitStr, myColorIndex
test2 Cells(counter, 3), hitStr, myColorIndex
counter = counter + 1
End If
Next j
Next i
End Sub

Private Sub test2(myRange As Range, targetString As String, myColorIndex As Long)
Dim startPos As Long

startPos = InStr(myRange.Value, targetString)
With myRange.Characters(Start:=startPos, Length:=Len(targetString)).Font
.ColorIndex = myColorIndex
End With
End Sub

回答No.4

kagakusuki

今仮に、下の添付画像の様に、Ｓｈｅｅｔ１のB列の2行目以下に元となる文章が入力されていて、C1から右方向に向かって番号が振られていて、例えば、C3セルには1番の文章と2番の文章で、重複している箇所が表示される様にするものとします。
　又、2つの文章の間に、10文字以上重複する箇所が、複数箇所存在する事は無いものとします。

【使用するＥｘｃｅｌのバージョンがＥｘｃｅｌ2007以降の場合】（Ｓｈｅｅｔ2は使用しません）
　まず、C2セルに次の数式を入力して下さい。

=IF(OR($B2="",OFFSET($B$1,COLUMNS($C:C),)="",ROWS($1:1)=COLUMNS($C:C)),"",MID($B2,LEN($B2)-INT(LOG(SUMPRODUCT(2^(LEN($B2)*ISNUMBER(FIND(MID($B2,ROW(INDIRECT("Z1:Z"&LEN($B2)-9)),10),OFFSET($B$1,COLUMNS($C:C),)))-ROW(INDIRECT("Z1:Z"&LEN($B2)-9)))),2)),SUMPRODUCT(ISNUMBER(FIND(MID($B2,ROW(INDIRECT("Z1:Z"&LEN($B2)-9)),10),OFFSET($B$1,COLUMNS($C:C),)))*1)+9))

　そして、C2セルをコピーして、重複箇所を表示させる全てのセル（セル範囲）に貼り付けて下さい。

【使用するＥｘｃｅｌのバージョンがＥｘｃｅｌ2007よりも前のバージョンの場合】
　適当な空きシート（ここでは仮にＳｈｅｅｔ2とします）を作業用Ｓｈｅｅｔ都市使用します。
　まず、Ｓｈｅｅｔ2のA2セルに次の数式を入力して下さい。

=IF(OR(Sheet1!$B2="",OFFSET(Sheet1!$B$1,COLUMNS($A:A),)="",ROWS($1:1)=COLUMNS($A$1:A1)),"",SUMPRODUCT(2^(LEN(Sheet1!$B2)*ISNUMBER(FIND(MID(Sheet1!$B2,ROW(INDIRECT("Z1:Z"&LEN(Sheet1!$B2)-9)),10),OFFSET(Sheet1!$B$1,COLUMNS($A:A),)))-ROW(INDIRECT("Z1:Z"&LEN(Sheet1!$B2)-9)))))

　次に、Ｓｈｅｅｔ2のA2セルをコピーして、例えば、元の文章が6個ある場合には、Ｓｈｅｅｔ2のA2が左上の隅となっている縦6行×横6列を上回るのに充分なセル範囲に貼り付けて下さい。

　次に、Sheet1のC2セルに次の数式を入力して下さい。

=MID($B2,LEN($B2)-IF(OR(Sheet2!A2="",OFFSET($B$1,COLUMNS($C:C),)=""),-1,INT(LOG(Sheet2!A2,2))),SUMPRODUCT(ISNUMBER(FIND(MID($B2,ROW(INDIRECT("Z1:Z"&LEN($B2)-9)),10),OFFSET($B$1,COLUMNS($C:C),)))*1)+9)

　次に、Sheet1のC2セルをコピーして、重複箇所を表示させる全てのセル（セル範囲）に貼り付けて下さい。

回答No.3

tom04

No.2です！
たびたびごめんなさい。

前回はコードが間違っていました。（キーの打ち間違い及び、コード不足です）

もう一度コードを載せてみます。

Sub test2() 'この行から
Dim i, j, k, vl As Long
Dim str As String
Application.ScreenUpdating = False
For i = 1 To Cells(Rows.Count, 1).End(xlUp).Row
For j = 1 To Len(Cells(i, 1)) - 9
For k = 10 To Len(Cells(i, 1))
str = Mid(Cells(i, 1), j, k)
If WorksheetFunction.CountIf(Columns(3), str) = 0 Then
With Cells(Rows.Count, 3).End(xlUp).Offset(1)
.Value = str
.Offset(, 1) = Len(str)
End With
End If
Next k
Next j
Next i
k = Cells(Rows.Count, 3).End(xlUp).Row
Range(Cells(2, 3), Cells(k, 5)).Sort key1:=Cells(1, 4), order1:=xlDescending
For j = 2 To Cells(Rows.Count, 3).End(xlUp).Row
For i = 2 To Cells(Rows.Count, 1).End(xlUp).Row
If Cells(i, 1) Like "*" & Cells(j, 3) & "*" Then
vl = vl + 1
End If
Next i
If vl > 1 Then
Cells(Rows.Count, 2).End(xlUp).Offset(1) = Cells(j, 3)
End If
vl = 0
Next j
For j = Cells(Rows.Count, 2).End(xlUp).Row To 3 Step -1
For i = 2 To j - 1
If Cells(i, 2) Like "*" & Cells(j, 2) & "*" Then
Cells(j, 2).Delete (xlUp)
End If
Next i
Next j
Application.ScreenUpdating = True
Columns("C:D").Delete
Columns(2).AutoFit
End Sub 'この行まで

※　いろいろなパターンでの検証をしていませんので、
希望通りにならなかったらごめんなさいね。m（＿ ＿）m

回答No.2

tom04

こんばんは！
ご希望の方法かどうかわかりませんが・・・
VBAの一例です。

A列の1行目から文字データが入っているとします。

画面左下の操作したいSheet見出し上で右クリック　→　コードの表示　→　VBE画面が出ますので
↓のコードをコピー＆ペーストしてマクロを実行してみてください。
（Alt＋F8キー　→　マクロ　→　マクロ実行です）

Sub test() 'この行から
Dim i, j, k, vl As Long
Dim str As String
Application.ScreenUpdating = False
For j = 1 To Len(Cells(1, 1)) - 9
For k = 10 To Len(Cells(1, 1))
str = Mid(Cells(1, 1), j, k)
If WorksheetFunction.CountIf(Columns(3), str) = 0 Then
With Cells(Rows.Count, 3).End(xlUp).Offset(1)
.Value = str
.Offset(, 1) = Len(str)
End With
End If
Next k
Next j
k = Cells(Rows.Count, 3).End(xlUp).Row
Range(Cells(2, 3), Cells(k, 5)).Sort key1:=Cells(1, 4), order1:=xlDescending
For j = 2 To Cells(Rows.Count, 3).End(xlUp).Row
For i = 2 To Cells(Rows.Count, 1).End(xlUp).Row
If Cells(i, 1) Like "*" & Cells(j, 3) & "*" Then
vl = vl + 1
End If
Next i
If vl > 1 Then
Cells(Rows.Count, 2).End(xlUp).Offset(1) = Cells(j, 3)
End If
vl = 0
Next j
For j = Cells(Rows.Count, 2).End(xlUp).Row To 3 Step -1
For i = 2 To j - 1
If Cells(i, 2) Like "*" & Cells(j, 2) & "*" Then
Cells(j, 2).Delete (xlUp)
End If
Next i
Next j
Application.ScreenUpdating = True
Columns("C:D").Delete
Columns(2).AutoFit
End Sub 'この行まで

※　これでB列10文字以上で重複する語句が表示されると思います。m（＿ ＿）m

回答No.1

imogasi

重複とは定義すると何？１０字以上という条件は別にして。１０字以上という条件は共通の文字列が見つかってから、１０文字未満は捨てれば良いだけの話でしょう。
珍しい質問とおもうが、難しそうだ。関数でなど考えているのかな。VBAで無いと出来ないのでは。VBAや他言語の経験あるのかな。
ーー
１０字以上という条件は別にして
１と２の「吾輩は」の部分を例として書いてないのはどうして？
ーーー
２つの文字列があり、両者で共通する文字列を探し出すアルゴリズムは難しいのでは。
質問者はどう考えているのかな。人間の直感を重きを置いて考えてはダメでしょう。
ーー
そういうことなら、２，３日に適当な回答が無ければ、このカテゴリではなく、数学や論理・情報（科学）に強い人が見るカテゴリに質問したら。
ーー
BM法と言うのを思い出したが、一方の文字列は人間が意味のある語句などを選ぶ場合ではないかと思うので
両方ともぶっつけて共通部分を見つけるのは難しそうだ。
ーー
2つの文字列の最長共通部分列(Longest Common Subsequence; LCS)を計算して出力する、なんていうのも在るが。
本質問では最長のものだけではないようだ。
ベクタターにもソフトが提供されているようだ
http://www.vector.co.jp/soft/winnt/util/se477688.html
Googleで「２つの文字列　共通する部分を見つける」で照会するとアルゴリズムは沢山解説記事があるようだ。