Excelマクロでファイルで重複する文字の削除方法

質問

Excel VBAについて確認させてください。

下記のExcelマクロはエクセルのA列に入力されてある文字を順に読み込んで
ユーザが入力したテキストファイル（＝FN1）を読み込んで
エクセルのA列に入力されてある文字が見つかった場合は削除する動作の繰り返し作業を行い、
エクセルのA列の文字が入力されてある最後の行まで行ったら
出力ファイル（＝FN2）として保存するプログラムです。

ここで出力ファイルにはエクセルのA列に入力されていない文字が
残るものと思われますが、ここで入力されていない文字で
重複する文字があった場合はまとめて一つにする方法をを
ご教授いただけますでしょうか。

以上お手数おかけしますがよろしくお願いします。
以下、プログラム本文です。
-----------------------------------------------
Sub sample()

Dim a As String
Dim y As Long
Dim x As String
Dim FN1 As String
Dim FN2 As String

x = InputBox("チェックするファイル名を入力してください。（拡張子も含めてください。）")

FN1 = ThisWorkbook.Path & "\" & x
FN2 = ThisWorkbook.Path & "\チェック済" & x

With CreateObject("Scripting.FileSystemObject").GetFile(FN1).OpenAsTextStream

a = .ReadAll

For y = 1 To Cells(Rows.Count, 1).End(xlUp).Row

a = Replace(a, Cells(y, 1), "") '読み込んだテキストファイルにエクセルのA列にある文字が見つかった場合削除
a = Replace(a, vbCrLf, "") '改行コードの削除
a = Replace(a, vbTab, "") 'タブコードの削除

Next
.Close
End With

With CreateObject("Scripting.FileSystemObject").OpenTextfile(FN2, 2, True)

.Write a
.Close

End With

End Sub

回答No.1

doara_2011 · ベストアンサー

こんな感じで如何でしょう？

Function test(str1 As String) As String
Dim dic As Object
Dim c As String, i As Long, v As Variant

Set dic = CreateObject("Scripting.Dictionary")
For i = 1 To Len(str1)
c = Mid$(str1, i, 1)
If Not dic.Exists(c) Then dic.Add c, i
Next i

test = ""
For Each v In dic.Keys
test = test & CStr(v)
Next
End Function

b = test(a) 等として呼び出して下さい。

お礼

遅くなって申し訳ございません。

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

分かりやすいご説明、誠にありがとうございます。

ご参考にさせていただきます。