>>964 複数回現れる単語を削除すればいいのか？ Sub X964() Dim Sheet As Worksheet: Set Sheet = ... Dim Dictionary As Object: Set Dictionary = CreateObject("Scripting.Dictionary") Dim LastRow As Long: LastRow = SheetSheet.Cells(Rows.Count, "A").End(xlUp).Row Dim Row As Long For Row = 1 To LastRow Dim Word As Variant For Each Word In Split(Sheet.Cells(Row, "A").Value, " ") If Dictionary.Exists(Word) Then Dictionary(Word) = Dictionary(Word) + 1 Else Dictionary.Add Word, 1 End If Next Next For Row = 1 To LastRow Dim Uniques As String: Uniques = "" For Each Word In Split(Sheet.Cells(Row, "A").Value, " ") If 1 < Dictionary(Word) Then If Uniques = "" Then Uniques = Word Else Uniques = Uniques & " " & Word End If End If Next Sheet.Cells(Row, "B").Value = Uniques Next End Sub
Sub sample3() Dim r As Long Dim z As Long '最終行 Dim s As String '全データ Dim a() As String '単語リスト Dim i As Long z = Cells(Rows.Count, 1).End(xlUp).Row For r = 1 To z Cells(r, 2) = Cells(r, 1) s = s & Cells(r, 1) & " " Next r a = Split(s, " ") For i = LBound(a) To UBound(a) If Len(s) - Len(a(i)) > Len(Replace(s, a(i), "")) Then '2回以上出てくるか For r = 1 To z Cells(r, 2) = Trim(Replace(Cells(r, 2), a(i), "")) '各セルから削除 Next r End If Next i End Sub
