こんにちはゲストさん。会員登録(無料)して質問・回答してみよう!

解決済みの質問

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

よろしくお願いします。

投稿日時 - 2009-03-05 15:09:23

QNo.4770539

すぐに回答ほしいです

質問者が選んだベストアンサー

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

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

投稿日時 - 2009-03-09 12:30:18

お礼

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

投稿日時 - 2009-03-09 13:53:47

このQ&Aは役に立ちましたか?

2人が「このQ&Aが役に立った」と投票しています

回答(8)

ANo.7

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

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

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

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

投稿日時 - 2009-03-06 13:19:02

お礼

何度もすいません。自分なりにここまでやってみました。
あと、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

投稿日時 - 2009-03-09 11:05:52

ANo.6

またまた登場、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
'----------------------------------
 
こんなかんじでしょうか。。
 

投稿日時 - 2009-03-06 11:35:34

お礼

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

投稿日時 - 2009-03-06 12:22:11

ANo.5

こんにちは。

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

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

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

  Microsoft Scripting Rumtime (scrrun.dll)

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

投稿日時 - 2009-03-06 03:54:10

ANo.4

こんなのはどうでしょうか?
[ファイル][開く]でテキストファイルを開く。
フィルタの仕様で範囲の先頭を見出しとするため、ダミーの見出しを挿入する。
[データ][フィルタ][フィルタオプションの設定]で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

投稿日時 - 2009-03-06 01:46:34

ANo.3

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

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

回答1と殆ど同じですが、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
'-------------------------------------------------

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

投稿日時 - 2009-03-06 00:05:44

お礼

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

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

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

投稿日時 - 2009-03-06 10:23:16

ANo.2

#1です。

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

投稿日時 - 2009-03-05 22:22:29

ANo.1

パスは適宜修正のこと。

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

ご参考まで。

投稿日時 - 2009-03-05 15:53:24

お礼

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

投稿日時 - 2009-03-05 22:01:15

あなたにオススメの質問