[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]
『テキストファイル内の任意の文字列に挟まれた数値データ（カンマ区切り）を配列に入れたいです。』（なゆた）
フォルダ内にあるテキストファイルを
sample_FileName(i)内に収納されているテキストデータ順に開き、
1行目から読み込み、任意の文字列を含む行と
更に別の任意の文字列に挟まれた数値データ（カンマ区切り）を
三次元の動的配列に入れたいです。
例として、
sample1.txt
2,4,2,5
2,2,2,2
A
1,4,5,5,7,,,
2,3,5,7,4,,,
2,4,4,8,7,,,
2,3,5,7,3,,,
2,4,1,0,7,,,
B
0,0,3,,
0,1,4,,
0,3,2,,
0,5,3,,
C
1011,1,1,1,0,0,0,,,,
1012,1,1,1,0,0,0,,,,
1013,1,1,1,0,0,0,,,,
1014,1,1,1,0,0,0,,,,
X
1,1,1
1,1,1
1,1,1
sample2.txt
sample3.txt
上記のようなテキストファイルがあったときに
1．AとBの間の数値データをカンマで区切り、arrayAに入れる。
2．BとCの間の数値データをカンマで区切り、arrayBに入れる。
2．CとXの間の数値データをカンマで区切り、arrayCに入れる。
4．X以降は不要
5．どのファイルもA,B,CおよびXの文字列があり、1行あたりの要素数は同じです。
条件としては、
1．それぞれの数値データの行数は不定です。
2．三次元配列arrayA or B or C(i,j,k)としたとき、
i = 読込んだファイルの順番
j = 行数
k = 要素数
としたいです。
3．配列の最小値は0ではなく1から始めたいです。
具体的にはSelect Caseによる条件分岐のあたりで手が止まっています。
静的配列を用いて多く要素をとれば対応はできそうなのですが、
なにぶん行数が不定なため、
できれば動的配列を用いて対応したいです。
不完全なコードで大変申し訳ございませんが、何卒お力添えを頂けますよう、
よろしくお願いいたします。
なお、読み込むファイルの数はfile_num、読み込むファイル名はsample_FileName(i)にそれぞれ格納しています。
今回だと、
file_num=3,
sample_FileName(i)＝｛sample1.txt,sample2.txt,sample3.txt｝（実際はフルパスで入っています）
となっています。
Sub input(file_num,sample_FileName)
Dim intFF As Integer 'FreeFile値
Dim myRec As String '読み込んだレコード内容
Dim myAry As Variant 'レコードを分割したデータ
Dim i As Long
For i = 1 To file_num
intFF = FreeFile
On Error GoTo err_on 'ファイルが見つからないときの処理
Open sample_FileName(i) For Input As #intFF
On Error GoTo 0
Do Until EOF(intFF)
Line Input #intFF, myRec
myAry = Split(myRec, ",")
Dim data_index As String
Dim j As Long
Select Case myAry(0) 'データ判定
Case "A": data_index = "A": j = 1
Case "B": data_index = "B": j = 1
Case "C": data_index = "C": j = 1
Case Val(myAry(0)) = 0: data_index = "X"
End Select
Select Case data_index
Case "A"
j = j + 1
Case "B"
j = j + 1
Case "C"
j = j + 1
End Select
Loop
Close #intFF
Next i
err_on:
MsgBox " 指定したデータがありません。"
Close
Application.StatusBar = "エラー終了しました。 "
End
End Sub
＜ 使用 Excel：Excel2013、使用 OS：Windows10 ＞
（マナ） 2021/09/25(土) 11:15
説明不足で申し訳ありません。
要素数には空白も含みます。
（なゆた） 2021/09/25(土) 11:34
また、配列を要素とする配列（ジャグ配列）というものも作れます。
別の考え方は取れませんか？
現在提示されているデータ構造が最適のものかどうかは、
ひとえに、そのデータに対して、どのような処理を予定しているのかに依存します。
どのような処理を前提としているのでしょうか？
支障の無い範囲で説明してもらえませんか？
（γ） 2021/09/25(土) 11:41
Sub test()
Dim fso As Object, f As Object
Dim p As String
Dim txt As String
Dim k As Long
Dim sss, ss, s
Set fso = CreateObject("scripting.filesystemobject")
p = "c:\○○○\△△\Sample1.txt"
Set f = fso.opentextfile(p)
txt = f.readall
f.Close
For k = 65 To 66
sss = Split(Split(txt, vbCrLf & Chr(k) & vbCrLf)(1), vbCrLf & Chr(k + 1) & vbCrLf)
ss = Split(sss(0), vbCrLf)
s = Split(ss(1), ",")
MsgBox UBound(ss) + 1
MsgBox UBound(s) + 1
Next
End Sub
（マナ） 2021/09/25(土) 12:16
＞＞「VBAでは動的配列は最後の軸（次元）に沿ってしか大きさを変えることはできない」
はい、存じ上げております。
今回の場合ですと、jが可変（三次元のうちの第二軸）であるために動的配列を適用するにあたって
少々困っています。
色々やり方を調べるにあたって、ジャグ配列が適用できそうかも考えてみましたが、
なにぶん、私の拙い知識ではコーディングが上手くいかず、苦慮しています。
＞＞現在提示されているデータ構造が最適のものかどうかは、
＞＞ひとえに、そのデータに対して、どのような処理を予定しているのかに依存します。
＞＞どのような処理を前提としているのでしょうか？
このコードは全体におけるインプットの一部で、最終的には配列同士の数値演算を行います。
また、演算結果はそれぞれのデータ（今回におけるsample1.txt,sample2.txt,sample3.txt）の数値が
相互に作用しているため、三次元配列を用いての計算が必要になります。
（なゆた） 2021/09/25(土) 13:13
興味本位でお聞きして恐縮です。
＞jが可変（三次元のうちの第二軸）であるために
可変の意味ですが、
sample1とsample2のデータで最大のjが異なることはあるんですか？
予め固定されてはいないが、3つとも同じということですか？
それとも異なるのですか？
まあ、いずれにしても読み込んでから、大きさを調べて、
個数の最大値でRedimし、
その後、順次、3次元配列に値をセットしていけばいいかもしれませんね。
既に適切な回答をいただいています。
（γ） 2021/09/25(土) 13:36
ご教示、ありがとうございます。
なるほど、ReadAllメソッドによって、テキストデータを一括で変数に入れるのですね。
ReadAllがあるのは存じ上げていましたが、知識と経験不足なため、適用可能かどうかまで
考えが至りませんでした。
そして、再びの説明不足で大変申し訳ございません。
そのあとのSplitによって文字列を区切る際、Chr(65)=Aを使用されていますが、
A,B,CおよびXは例のための仮の文字で、本来は別の単語が入っています。
それならば、その単語によって区切り判定をすればよいのではとも考えましたが、
データの順番も不定（A→C→Bの順になることもあります）であるため、
Select Caseを用いた判定に至った次第です。
言葉足らずで混乱を招いてしまい、大変申し訳ございません。
不躾とは存じますが、ご考慮いただければ幸いです。
（なゆた） 2021/09/25(土) 13:42
ご返信、ありがとうございます。
＞＞sample1とsample2のデータで最大のjが異なることはあるんですか？
＞＞予め固定されてはいないが、3つとも同じということですか？
その点も説明不足で申し訳ございません。
jの最大はそれぞれのデータで異なります。
そのため、三次元配列においては、その中でももっとも大きいjの値が、第二軸の大きさとなります。
＞＞まあ、いずれにしても読み込んでから、大きさを調べて、
＞＞個数の最大値でRedimし、
＞＞その後、順次、3次元配列に値をセットしていけばいいかもしれませんね。
＞＞既に適切な回答をいただいています。
となりますと、
一回すべてのデータを読み込み、i,j,kの最大値を入手
↓
Redimにより配列のサイズを決める
↓
もう一度、すべてのデータを読み込み
適切な位置に値をセットする
といった流れになりますでしょうか？
（なゆた） 2021/09/25(土) 13:54
(なお、UBoundの値がそれぞれ異なるなら、3次元配列の値について
missing dataと0値は区別しないといけないですね。) （γ） 2021/09/25(土) 14:07
Sub main()
Dim file_num As Long
Dim sample_FileName(1 To 3)
Dim aryA, aryB, aryC
sample_FileName(1) = "D:\sample1.txt"
sample_FileName(2) = "D:\sample2.txt"
sample_FileName(3) = "D:\sample3.txt"
file_num = UBound(sample_FileName)
InputFile file_num, sample_FileName, aryA, aryB, aryC
PrintAry aryA
PrintAry aryB
PrintAry aryC
End Sub
Sub InputFile(file_num, sample_FileName, aryA, aryB, aryC)
Dim BlockDelimiter() As Variant
BlockDelimiter = Array("A", "B", "C", "X")
Dim fileContents As Object
ReDim aryA(1 To file_num), aryB(1 To file_num), aryC(1 To file_num)
For i = 1 To file_num
Set fileContents = CreateObject("Scripting.Dictionary")
ReadFile sample_FileName(i), BlockDelimiter, fileContents
aryA(i) = fileContents(BlockDelimiter(0))
aryB(i) = fileContents(BlockDelimiter(1))
aryC(i) = fileContents(BlockDelimiter(2))
Set fileContents = Nothing
Next
End Sub
Sub ReadFile(filename, BlockDelimiter, fileContents As Object)
Dim fn As Integer, i As Long, j As Long, k As Long
Dim Buf() As Long
Dim LineNum As Long, FieldNum As Long
fn = FreeFile
Open filename For Input As #fn
i = LBound(BlockDelimiter)
For i = LBound(BlockDelimiter) To UBound(BlockDelimiter) - 1
SearchBlock fn, BlockDelimiter(i), BlockDelimiter(i + 1), LineNum, FieldNum
ReDim Buf(1 To LineNum, 1 To FieldNum)
For j = 1 To LineNum
For k = 1 To FieldNum
Input #fn, Buf(j, k)
Next
Next
fileContents.Add BlockDelimiter(i), Buf
Next
Close
End Sub
Sub SearchBlock(fn, KeyStart, KeyEnd, LineNum, FieldNum)
Dim BlockStart As Long, LineCount As Long, FieldCount As Long
Dim Buf As String
'Seek #fn, 1 なくてもいい？ ブロックの順番が不定のときは必要
Do While Not EOF(fn)
Line Input #fn, Buf
If Buf = KeyEnd Then Exit Do
LineCount = LineCount + 1
FieldCount = UBound(Split(Buf, ",")) + 1
If Buf = KeyStart Then
BlockStart = Seek(fn)
LineCount = 0
FieldCount = 0
End If
Loop
Seek #fn, BlockStart
LineNum = LineCount
FieldNum = FieldCount
End Sub
Sub PrintAry(Ary)
Dim i, j, k
For i = LBound(Ary) To UBound(Ary)
For j = LBound(Ary(i)) To UBound(Ary(i))
For k = LBound(Ary(i), 2) To UBound(Ary(i), 2)
Debug.Print Ary(i)(j, k);
Next
Debug.Print
Next
Debug.Print
Next
End Sub
不都合があったのでちょと修正
（´・ω・`） 2021/09/25(土) 15:35
コードのご教示、ありがとうございます。
まだ中身を深く見れていないので、大まかで申し訳ございませんが、
BlockDelimiterに判定に使いたい文字列（A,B,C,X）を一次元配列で収納
↓
fileContentsにDictionaryオブジェクトをセット
↓
〜〜〜〜〜〜〜〜〜〜〜〜〜〜〜〜
ReadFileにてファイルを読込
↓
SearchBlockにてブロックの行数および要素数を取得
↓
二次元配列Bufにファイル内のブロックの内容を収納
↓
BlockDelimiterに追加する。
〜〜〜〜〜〜〜〜〜〜〜〜〜〜〜〜
↓
〜〜〜内の内容を各ブロックで行う
↓
以上の作業をファイル数分行う。
↓
最後に三次元配列にデータを収納
という認識でよろしいでしょうか？
Dictionaryオブジェクトを使うというのは思い当たりませんでした。
まだまだ知識不足なため、うまく扱えるかはわかりませんが参考にさせていただきます。
（なゆた） 2021/09/25(土) 17:44
>正確にいうとフラットな3次元配列では無いですよ。 2次元配列を要素とする1次元配列ですね。
aryA(i) = fileContents(BlockDelimiter(0)) のところで、もいっちょプロシジャをかませばいいのですが、 力尽きたというか、外出の予定があったので、時間切れでした （´・ω・`） 2021/09/25(土) 18:09
（γ） 2021/09/25(土) 19:10
# 外出から戻ったところです。
（γ） 2021/09/25(土) 19:13
sample1,sample2,sample3をそれぞれ普通に別のシートに読み込んで、
数値計算が出来ませんか？
どんな計算をしようとしていますか？
（γ） 2021/09/25(土) 20:57
質問者さんへのもう一つの確認です。
B
0,0,3,,
0,1,4,,
0,3,2,,
0,5,3,,
と言うデータについて、
(1)一行目の最後の2要素
(2)別のファイルでは B が5行あるとき、上記のデータの5行目の要素
これらには、どのような値を設定する積もりなんでしょうか？
0なんですか？Empty値ですか？それとも、それ以外の何か？
されようとしている計算に即して回答ください。
（γ） 2021/09/26(日) 12:00
こんなに面倒なことになるのは、何かが間違っているのだと思う。 やろうとすることなのか、使おうとする道具なのか、いずれなのか不明ですが。
質問に反応もないのが残念です。まあ、休日ですけどね。 手元のものが無駄になるのでコードを載せて、区切りにしておきます。 （マジックナンバーが中途半端に残ってしまっていて、 余りなコードですが、切りがないのでこの辺で。）
Option Explicit
Const nOfFiles As Long = 3 'ファイルの数(■要修正) Dim fileNameArray As Variant Dim dic() As Object Dim fso As Object
Sub test()
Dim arrayA, arrayB, arrayC
Dim headers As Variant
ReDim dic(1 To nOfFiles)
fileNameArray = Array("sample1.txt", "sample2.txt", "sample3.txt") '■要修正
Call getData ' (1)ファイルからデータを読み取り、2次元配列をdicに保持
headers = dic(1).keys
'(2)3次元配列に変換
'arrayA,arrayB,arrayCが求める3次元配列
arrayA = get3dimArray(headers(0))
arrayB = get3dimArray(headers(1))
arrayC = get3dimArray(headers(2))
Stop
End Sub
Function getData() '結果は dic() に保持
Dim re As Object
Dim matches As Object
Dim m As Object
Dim s As String
Dim j&, k&
Dim header(1 To 3) As String
Dim data(1 To 3) As String
'正規表現（パターンマッチのツール）の設定
Set re = CreateObject("VBScript.RegExp")
With re
.Global = True
.Pattern = "([^,\r\n]*)\r\n((?:[\d.,-]+\r\n)+)"
End With
'データを読み込み、二次元配列に変換して辞書に保存
For k = 1 To nOfFiles
s = getAllTexts(fileNameArray(k - 1)) ' textファイルから一括読み込み
Set dic(k) = CreateObject("Scripting.Dictionary")
Set matches = re.Execute(s)
For j = 1 To matches.Count - 2 '最初(j=0)は不要につき飛ばす。最後のマッチも捨てる
Set m = matches(j)
header(j) = Trim(m.SubMatches(0)) '見出し文字列
data(j) = Left(m.SubMatches(1), Len(m.SubMatches(1)) - 2) '該当文字列
dic(k)(header(j)) = get2dimArray(data(j)) '二次元配列化して辞書に保存
Next
Next
End Function
Function getAllTexts(filename As Variant) As String
Dim f As Object
If fso Is Nothing Then
Set fso = CreateObject("scripting.filesystemobject")
End If
Set f = fso.OpenTextFile(filename)
getAllTexts = f.ReadAll
f.Close
End Function
'改行を含む文字列s を、改行とカンマで区切り、二次元配列(各要素は文字列)とする
Function get2dimArray(s As String) As Variant
Dim a
Dim m&, n&, p&, q&
Dim mat()
Dim e1, e2
a = Split(s, vbCrLf)
m = UBound(a, 1) + 1
n = UBound(Split(a(0), ",")) + 1
ReDim mat(1 To m, 1 To n)
p = 0
For Each e1 In a
p = p + 1
q = 0
For Each e2 In Split(e1, ",")
q = q + 1
mat(p, q) = e2
Next
Next
get2dimArray = mat
End Function
Function get3dimArray(header As Variant) As Variant
Dim mat
Dim max1&, max2&
Dim k&, r&, c&
'uboundの最大値を計算
max1 = 0
max2 = 0
For k = 1 To nOfFiles
mat = dic(k)(header)
If UBound(mat, 1) > max1 Then max1 = UBound(mat, 1)
If UBound(mat, 2) > max2 Then max2 = UBound(mat, 2)
Next
'3次元配列に転記
ReDim matrix(1 To nOfFiles, 1 To max1, 1 To max2) ''''As Double
For k = 1 To nOfFiles
mat = dic(k)(header)
For r = 1 To UBound(mat, 1)
For c = 1 To UBound(mat, 2)
'数値(0含む)だけを対象に書き込む。数値以外はEmpty値のままである。
If IsNumeric(mat(r, c)) Then
matrix(k, r, c) = CDbl(mat(r, c))
End If
Next
Next
Next
get3dimArray = matrix
End Function
# ワークシート上でやれば、さほど難しい話ではなかった、 # ということになりそうな気がしています。 （γ） 2021/09/26(日) 20:05
職場が休日のため、コードの中身が確認できず、
返信が遅れてしまい、大変申し訳ございません。
今回の質問に至った経緯につきまして、説明いたします。
現在、前任者のコードのブラッシュアップを行っています。
今あるコードは問題なく動くのですが、対応できる条件が限定的であり、
今後の業務において適用が難しくなっています。
（具体的には現在のコードでは、jが可変の際に対応できません）
また、実際の計算は別のソフトにて行うのですが
書出しのための別プロシージャにおいて、インプットデータが三次元配列に
入っているため、そちらを大きく変えることの無いように対応したかったため
今回の質問に至りました。
私の知識および説明不足な点が多々あり、皆様に多大な迷惑をかけてしまったこと
重ねて、お詫び申し上げます。
また、試行錯誤の末、希望している結果が得られましたので、
あまり美しいコーディングとは言えませんが、こちらに記載いたします。
Sub ST3_inp(file_num, sample_FileName, arrayA, arrayB, arrayC)
Dim intFF As Integer 'FreeFile値
Dim myRec As String '読み込んだレコード内容
Dim myAry As Variant 'レコードを分割したデータ
Dim ary2DA As Variant
Dim ary2DB As Variant
Dim ary2DC As Variant
Dim i As Long
For i = 1 To file_num
intFF = FreeFile
On Error GoTo err_on
Open sample_FileName(i) For Input As #intFF
On Error GoTo 0
Do Until EOF(intFF)
Line Input #intFF, myRec
myAry = Split(myRec, ",")
Dim data_index As String
Dim j As Long
Dim k As Long
If IsNumeric(myAry(0)) = False Then
Select Case myAry(0) 'データ判定
Case "A": data_index = "A"
Case "B": data_index = "B"
Case "C": data_index = "C"
Case Else: data_index = "X"
End Select
j = 0
Else
End If
Select Case data_index
Case "A"
If j = 0 Then
j = j + 1
ReDim ary2DA(5, 1 To j)
Else
ReDim Preserve ary2DA(5, 1 To j)
For k = 1 To 5
ary2DA(k, j) = Val(myAry(k))
Next k
j = j + 1
End If
Case "B"
If j = 0 Then
j = j + 1
ReDim ary2DB(3, 1 To j)
Else
ReDim Preserve ary2DA(3, 1 To j)
For k = 1 To 3
ary2DA(k, j) = Val(myAry(k))
Next k
j = j + 1
End If
Case "C"
If j = 0 Then
j = j + 1
ReDim ary2DC(7, 1 To j)
Else
ReDim Preserve aryMAT(7, 1 To j)
For k = 1 To 7
aryMAT(k, j) = Val(myAry(k))
Next k
j = j + 1
End If
End Select
Loop
Close #intFF
'取得した2次元データを3次元配列に格納
Call redim_2to3(i, ary2DA, arrayA)
Call redim_2to3(i, ary2DB, arrayB)
Call redim_2to3(i, ary2DC, arrayC)
Next i
'3次元配列の第2軸と第3軸を転置
Call temp_ary3D(file_num, arrayA)
Call temp_ary3D(file_num, arrayB)
Call temp_ary3D(file_num, arrayC)
Exit Sub
err_on:
MsgBox " 指定したデータがありません。"
Close
Application.StatusBar = "エラー終了しました。 "
End
End Sub
Sub redim_2to3(ByVal i As Long, ByVal ary2D As Variant, ByRef ary3D As Variant)
Dim myary3D As Variant
Dim jtoj As Long
Dim ktok As Long
If i = 1 Then
ReDim ary3D(1 To file_num, 1 To UBound(ary2D, 1), 1 To UBound(ary2D, 2))
ElseIf i >= 2 Then
If UBound(ary3D, 3) < UBound(ary2D, 2) Then
ReDim Preserve ary3D(1 To tower_num, 1 To UBound(ary2D, 1), 1 To UBound(ary2D, 2))
End If
End If
For ktok = 1 To UBound(ary2D, 1)
For jtoj = 1 To UBound(ary2D, 2)
ary3D(i, ktok, jtoj) = ary2D(ktok, jtoj)
Next jtoj
Next ktok
End Sub
Sub temp_ary3D(ByVal file_num As Long, ByRef ary3D As Variant)
Dim temp_ary3D As Variant
Dim x As Long
Dim y As Long
Dim z As Long
temp_ary3D = ary3D
Erase ary3D
ReDim ary3D(1 To file_num, 1 To UBound(temp_ary3D, 3), 1 To UBound(temp_ary3D, 2))
For x = 1 To file_num
For y = 1 To UBound(temp_ary3D, 3)
For z = 1 To UBound(temp_ary3D, 2)
ary3D(x, y, z) = temp_ary3D(x, z, y)
Next z
Next y
Next x
End Sub
（なゆた） 2021/09/27(月) 09:32
[ 一覧(最新更新順) ]
YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki.
Modified by kazu.