セル内の重複英単語を削除したいです。

質問

セル内の重複英単語を削除したいです。
A列にある3000行くらいをB列に重複削除でお願いいたします。

削除作業時は以下のような条件でお願いいたします。
単語と単語の間は、半角スペースか全角スペース（重複削除時に半角スペースに統一で構いません)。
大文字と小文字の区別なしで削除(apple　Apple　APPLEはすべて重複とする)。
１つのセルで重複はほとんど１つ(同じ英単語が２つ）なので、１つの重複削除作業でも可。
重複削除する場合、最初の英単語を残し後の英単語を削除。

例
apple　orange　Apple
↓
apple orange

以上です。
Windows7
エクセル2010。

回答No.4

m_and_dmp

重複のパターンが多くなければ「置換」で処理したほうがわかりやすくて、速いです。

ととえば、
検索する文字列（置換対象文字列）を apple orange Apple
置換後の文字列を　apple orange
とします。

置換オプションでは、
□大文字と小文字を区別する
□半角と全角を区別する
のチェックをはずしておいたほうがいいと思います（デフォルトではチェックは外れている）

回答No.3

KURUMITO

関数を使って対応する方法です。
Ａ列のセルには英単語が５つまで入力されている場合の一例です。
初めにＡ列を選択してから「データ」タブの「区切り位置」をクリックし、表示の1/3の画面で「次へ」、２/３の画面で区切り文字の項の「スペース」にチェックをして「次へ」、３/３の画面で表示先の窓には$C$1と入力して「完了」をクリックします。
Ｃ列からＧ列までにＡ列に入力されている単語が並びます。
そこでＩ１セルには次の式を入力してＭ１セルまで横にドラッグコピーしたのちに下方にもドラッグコピーします。

=IF($A1="","",IF(COUNTIF($C1:C1,C1)=1,IF(COLUMN(A1)=1,ASC(C1),H1&" "&ASC(C1)),H1))

最後にＢ１セルには次の式を入力して下方にドラッグコピーします。

=M1

作業列になっている列が目障りでしたらそれらの列を選択して右クリックし、「非表示」を選択すればよいでしょう。
なお、作業列を削除したい場合にはＢ列を選択して「コピー」し、その後にＢ１セルがアクティブ状態のままで、「形式を選択して貼り付け」で「値」にチェックをして貼り付けを行います。

回答No.2

tom04

こんにちは！
やっているコトはNo.1さんとほとんど一緒ですが・・・

A1セルからデータがありB列に表示するとします。
画面左下の操作したいSheet見出し上で右クリック　→　コードの表示　→　VBE画面に
↓のコードをコピー＆ペーストしてマクロを実行してみてください。
（Alt＋F8キー　→　マクロ　→　マクロ実行です）

Sub Sample1() 'この行から
Dim i As Long, k As Long, buf As String, myArray, tmp
Application.ScreenUpdating = False
For i = 1 To Cells(Rows.Count, 1).End(xlUp).Row
tmp = Replace(StrConv(Cells(i, 1), vbNarrow), " ", ",")
myArray = Split(tmp, ",")
For k = 0 To UBound(myArray)
If InStr(UCase(buf), UCase(myArray(k))) = 0 Then
buf = buf & myArray(k) & " "
End If
Next k
Cells(i, 2) = Left(buf, Len(buf) - 1)
buf = ""
Next i
Application.ScreenUpdating = True
End Sub 'この行まで

こんな感じではどうでしょうか？m（_ _）m

回答No.1

tsubuyuki

いわゆる、マクロです。

Sub sample()
Dim myDic As Object, myKey As Variant
Dim temp As Variant, myStr As String
Dim i As Long, j As Long

　　　　For i = 1 To Cells(Rows.Count, 1).End(xlUp).Row
　　　　　　　　myStr = ""
　　　　　　　　Set myDic = CreateObject("Scripting.Dictionary")
　　　　　　　　temp = Split(StrConv(StrConv(Cells(i, 1), vbNarrow), vbLowerCase), " ")
　　　　　　　　For j = 0 To UBound(temp)
　　　　　　　　　　　　On Error Resume Next
　　　　　　　　　　　　　　　　myDic.Add temp(j), temp(j)
　　　　　　　　　　　　On Error GoTo 0
　　　　　　　　Next j
　　　　　　　　myKey = myDic.keys
　　　　　　　　For j = 0 To myDic.Count - 1
　　　　　　　　　　　　myStr = myStr & myKey(j) & " "
　　　　　　　　Next j
　　　　　　　　Cells(i, 1) = myStr
　　　　　　　　Set myDic = Nothing
　　　　Next i
End Sub

やっていることは
・Ａ列の全データに対し
・半角に変換、さらに小文字に変換したものを
・スペース「" "」で区切ったものを配列に格納
・それぞれを「重複無し」のDictionaryに格納
　（ここで前にあったものは格納されない）
・Dictionaryに格納された文字列を結合
・元のセルに入力
という処理です。

ただし、各セルに対しで全て小文字変換しますので、
「最初に出るパターンが大文字なら大文字のまま返す」
ということは出来ていません。

配列配列で頑張らせているので、３０００行で３秒ほどかかってしまうのが難点ではあります。

ワークシート関数での処理をお望みの場合は、賢人の出現をお待ち下さいませ。