Notes

Sub ary_Click()

'Office TANAKA - Excel VBAファイルの操作[名前を指定してブックを開く] http://officetanaka.net/excel/vba/file/file02.htm
'ファイルの操作(Shift-JIS/UTF8対応)[ExcelのVBA] http://www.petitmonte.com/excel/excel_vba_22.html

MsgBox "分析対象のファイルを選択してください。"

Dim OpenFileName As String '分析対象のテキストファイル名
Dim data As String 'テキストファイルの全文を格納
OpenFileName = Application.GetOpenFilename("テキストファイル,*.txt?")

Dim Stream As Object

' VB標準のADODB.Streamオブジェクトを作成する
Set Stream = CreateObject("ADODB.Stream")

' ストリームの文字コードをUTF8に設定する
Stream.Charset = "UTF-8"
' ファイルのタイプ(1:バイナリ 2:テキスト)
Stream.Type = 2
' ストリームを開く
Stream.Open
' ストリームにファイルを読み込む
Stream.LoadFromFile (OpenFileName)
' ファイルの中身をdataへ代入
data = Stream.ReadText
' ストリームを閉じる
Stream.Close
Debug.Print data
Set Stream = Nothing

'セル内の文字列を1文字ずつ配列変数に代入する:エクセルマクロ・Excel VBAの使い方-配列 http://www.relief.jp/itnote/archives/excel-vba-fill-array-with-each-characters.php
Dim arr() As String 'テキストを一文字ごとに区切って配列に格納
Dim i As Long 'Forループ用

ReDim arr(1 To Len(data)) '配列のサイズを決める,添字の最小値は「1」

For i = 1 To UBound(arr) '1から、添字の最大値までループ
arr(i) = Mid(data, i, 1) 'Mid関数を使って、1文字ずつ配列変数・arr()に代入
Next i

'Dim test As String
'For i = LBound(arr) To UBound(arr)
' test = test & arr(i) & ","
'Next i
'Range("A2") = test

'VBA Dictionaryオブジェクトを使って配列の要素の合計数を集計する。 - t-hom’s diary http://thom.hateblo.jp/entry/2015/08/16/214558
'全ては時の中に… : 【Excel VBA】Printステートメントに改行コードを含めない方法 http://blog.livedoor.jp/akf0/archives/51597085.html

'Dictionary（≒連想配列）に文字と出現回数を登録
Dim DIC As Object
Set DIC = CreateObject("Scripting.Dictionary")
For Each x In arr
If DIC.Exists(x) Then
DIC.Item(x) = DIC.Item(x) + 1
Else
DIC.Add x, 1
End If
Next

'結果の出力

MsgBox "結果出力先フォルダを選択してください。"

Dim FileNumber As Integer 'ファイルID
Dim Path As String 'フォルダパス

FileNumber = FreeFile '使用されていないファイル番号を取得する

'フォルダを選択
With Application.FileDialog(msoFileDialogFolderPicker)
If .Show = True Then
Path = .SelectedItems(1)
End If
End With

Path = Path & "result.txt"

'Open Path For Output As #FileNumber 'ファイルを開く

Dim Stream2 As Object

' VB標準のADODB.Stream2オブジェクトを作成する
Set Stream2 = CreateObject("ADODB.Stream")

' ストリームの文字コードをUTF8に設定する
Stream2.Charset = "UTF-8"
' ファイルのタイプ(1:バイナリ 2:テキスト)
Stream2.Type = 2
' スDim Stream2 As トリームを開く
Stream2.Open
' ストリームの保存形式をテキスト形式にする

Dim result As String


For Each k In DIC.Keys
result = result & k & ":" & DIC(k) & vbNewLine
Next

Debug.Print result

Stream2.WriteText result
' ストリームに名前を付けて保存する(1は新規作成 2は上書き保存)
Stream2.SaveToFile (Path), 2
' ストリームを閉じる
Stream2.Close
Set Stream2 = Nothing


'完了メッセージ
MsgBox "お待たせしました。" & vbNewLine & "処理が終わりました。"

End Sub