Excel VBA 文字列を配列にて格納

質問

初心者なので、申し訳ございません。
使用しているOS WinXP、アプリケーション Excel2003

保存してあるtxtファイルに入っている文字列を、重複するデータをグループ化して、最終的に別のtxtファイルにて出力するのですが、最初の配列して格納するところから分かりません。

参考までに・・・
入力ファイル「InputData.txt」
相川
関本
川上
関本
久保
相川
川上
久保
青木

出力ファイル「Group.txt」
相川
関本
川上
久保
青木

今のところは、ここまでやっています。
Dim A As String
Dim myText2 As String
A = Dir("InputDate.txt")

If A = "InputDate.txt" Then
Open A For Input As #1
Do While Not EOF(1)
Input #1, myText2
myText = myText & myText2
Loop

Open "Group.txt" For Output As #2

よろしくお願いします。

回答No.8

excel_abc · ベストアンサー

参考につくってみました。
一度、お試しください。

Sub uniq2()

Dim pFile As String
Dim pText As String

Dim pItem
Dim pPath As String
Dim pList() As String
Dim pFunc As Boolean
Dim i As Long, j As Long

pPath = ThisWorkbook.Path & "\"

pFile = Dir(pPath & "InputData.txt")

If pFile = "" Then Exit Sub

Open pPath & pFile For Input As #1
Do While Not EOF(1)
Input #1, pText

If pText <> "" Then
If i = 0 Then
ReDim pList(i)
pList(i) = pText
Else
For j = 0 To UBound(pList)
If pList(j) = pText Then
pFunc = True
Exit For
Else
pFunc = False
End If
Next j

If pFunc = False Then
ReDim Preserve pList(UBound(pList) + 1)
pList(UBound(pList)) = pText
End If

End If
i = i + 1
End If

Loop

Close #1

Open pPath & "Group.txt" For Output As #2
For i = 0 To UBound(pList)
Print #2, pList(i)
Next i
Close #2

End Sub

お礼

ありがとうございます。
無事に解決しました。

回答No.7

onlyrom

またまたまた登場、onlyromです。

＞同一範囲内に宣言が重複しているとのエラーが出てきました
＞どうしてなのでしょうか?

これには、宣言が重複しているから、としかこたえようがありません。
宣言重複はご自分で調べるしかありません。
誰も質問者の現在のコードは知らないのですから。。(^^;;;

と、まあ、それは置いといて。。。

そのコードを再度実行して、エラーメッセージが出たら「デバッグ」ボタンをクリック。
するとコードが表示され、エラー箇所が色付けされてるはずです。
それがダブって宣言されているということです。
完全なダブりだったら削除して
タイプミスだったら別名に変更してください。

お礼

何度もすいません。自分なりにここまでやってみました。
あと、bufに一時格納したデータを1個ずつダブっていないかチェックしたいと思うのですが、何かいい関数はないのでしょうか?
僕なりにはInStrRevやReplace関数のかなと思っているのですが…。

Dim myFile As String
Dim myText As String
Dim myText2 As String
Dim buf As String
Dim buf() As String
Dim cnt As Long

cnt = 0

myFile = Dir("InputDate.txt")

'ファイルの読み込み
If myFile = "InputDate.txt" Then
Open myFile For Input As #1

Do While Not EOF(1)
Line Input #1, buf

ReDim Preserve buf(cnt)
buf(cnt) = myText2
cnt = cnt + 1

回答No.6

onlyrom

またまた登場、onlyromです。

＞1行ずつデータを読み込み、配列として代数に格納するとき
＞配列の宣言においてLoopでその都度要素数を変更し、
＞なおかつ内容が初期化されないようにRedimやPreserveを使って

'---------- その部分だけ-----

Dim Cnt As Long
Dim myText() As String

Cnt = 0

Open A For Input As #1
Do While Not EOF(1)
　　Input #1, myText2

　　ReDim Preserve myText(Cnt)
　　myText(Cnt) = myText2
　　Cnt = Cnt + 1
Loop
Close #1
'----------------------------------

こんなかんじでしょうか。。

お礼

何度もすいません。
実際に、該当部分にあてはめてみましたが、同一範囲内に宣言が重複しているとのエラーが出てきました。どうしてなのでしょうか?

回答No.5

KenKen_SP

こんにちは。

> ちなみに、これではCreateObjectを使っていますが、OSによって
> バグが生じると聞きます。

CreateObject で参照する Dll, タイプライブラリ等が PC によって
インストールされていない場合があるということですよね。
別に CreateObject 自体に問題があるわけではありませんよ。

#1 ご回答の Dictionary オブジェクトは参照設定で言えば、

　　Microsoft Scripting Rumtime　(scrrun.dll)

ですが、恐らく Office97 以降、Office2000 以降なら間違いなく、Office
と同時に scrrun.dll がインストールされるはずですし、Office が未インス
トールだとしても、余程古い Windows でない限り、OS 標準の状態で動く
はずです。

回答No.4

hotosys

こんなのはどうでしょうか？
[ファイル][開く]でテキストファイルを開く。
フィルタの仕様で範囲の先頭を見出しとするため、ダミーの見出しを挿入する。
[データ][フィルタ][フィルタオプションの設定]でB列に重複を削除して表示する。
ダミーの見出しを削除する。
A列を削除してテキスト形式で保存。
をvbaで実行します。
Sub sample()
Workbooks.OpenText Filename:=ThisWorkbook.Path & "\InputData.txt", FieldInfo:=Array(1, xlTextFormat)
Rows(1).Insert
Range("A1") = "dmy"
Columns("A").AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Range("B1"), Unique:=True
Rows(1).Delete
Columns("A").Delete
ActiveWorkbook.SaveAs Filename:=ThisWorkbook.Path & "\Group.txt", FileFormat:=xlText
ActiveWorkbook.Close SaveChanges:=False
End Sub

回答No.3

onlyrom

＞ちなみに、これではCreateObjectを使っていますが、OSによってバグが生じると聞きます

　That's news to me!!。(^^;;;

回答１と殆ど同じですが、Collectionオブジェクトはどうでしょう。

'-------------------------------------　
Sub Test()
　Dim A As String
　Dim myText2 As String

　Dim myItem
　Dim myPath As String
　Dim myCollection As New Collection

　myPath = ThisWorkbook.Path & "\"

　A = Dir(myPath & "InputDate.txt")

　If A = "" Then Exit Sub

　　　On Error Resume Next
　　　Open myPath & A For Input As #1
　　　　　Do While Not EOF(1)
　　　　　　　Input #1, myText2
　　　　　　　myCollection.Add myText2, myText2
　　　　　　　Err.Clear
　　　　　Loop
　　　Close #1

　　　Open myPath & "Group.txt" For Output As #2
　　　　　For Each myItem In myCollection
　　　　　　　Print #2, myItem
　　　　　Next myItem
　　　Close #2

End Sub
'-------------------------------------------------

別案として先ずエクセルに読み込んで重複を除くフィルターをかけ
それを書き込む方法もありますね。

お礼

そういう方法もあるんですね。
確かにその方法の方がイメージがわきやすいですね。
ただ、今回はエクセルに読み込ませずに行う方法でとの指示が出ているので残念です。

もし、1行ずつデータを読み込み、配列として代数に格納するとき、配列の宣言においてLoopでその都度要素数を変更し、なおかつ内容が初期化されないようにRedimやPreserveを使って行おうとすれば、どのようにすればいいのでしょうか?参考書ではエクセルのデータや直接入力での例が大半で、実際どのようにすればいいのか分からなくて困っています。

いろいろと申し訳ないですが、宜しくお願いします。

回答No.2

n-jun

＃１です。

＞ちなみに、これではCreateObjectを使っていますが、OSによってバグが生じると聞きます。
そうなんですか？
その辺は詳しくないです。ごめんなさい。

回答No.1

n-jun

パスは適宜修正のこと。

Sub try()
Dim myDic As Object
Dim myFile As String
Dim myText As String
Dim myKey As Variant

Set myDic = CreateObject("Scripting.Dictionary")

myFile = Dir("R:\InputData.txt")

'ファイルの読み込み
If myFile = "InputData.txt" Then
Open "R:\" & myFile For Input As #1

Do While Not EOF(1)
Input #1, myText
myDic(myText) = Empty
Loop

Close #1

'書き込みファイルの作成
Open "R:\Group.txt" For Output As #2

For Each myKey In myDic.keys
Print #2, myKey
Next

Close #2

Set myDic = Nothing
'エラーメッセージの表示
Else
MsgBox "ファイルは存在しません。"
End If
End Sub

ご参考まで。

お礼

ご指導ありがとうございます。
ちなみに、これではCreateObjectを使っていますが、OSによってバグが生じると聞きます。
これを用いずにプログラムを組む方法があれば教えていただけないでしょうか？
宜しくお願いいたします。