[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]
『テキストファイルの全行の最大タブ区切り数を取得』（カシスソーダ）
こんにちは、よろしくお願いいたします。 ダイアログなどで指定したテキストファイルの内容をリストボックスに 取り込むコードの効率化を考えています。
現状では、 1 一度テキストファイルの内容を取得し変数に格納
2 変数に格納したテキストファイルの内容をVbCrlfでSplitし行数(Uboundを変数RowNumに格納)を取得
3 Splitした各行をループし各行をTabでSplitしたUboundを取得(変数に格納した最大Tab区切り数(TabMax)
と比較しその行のTab区切り数の方が多かったら変数にTab区切り数(TabMax)を格納しなおす)
4 配列の列数(TabMax)・行数を設定
5 テキストファイルの内容をループで配列に格納
6 配列の内容をリストボックスに一括転記
としています。
テキストファイルの行数・列数はそれほど多くない(行数は多くても500程度・列数は5程度)ので上記の 方法でもさほどストレスは感じていませんが、もし一発で最大Tab区切り数を取得する方法があればと思い 質問させていただきました。
もし方法がありましたらご教示お願いいたします。
ウィンドウズはXP(SP3) エクセルは2002です。よろしくお願いいたします。
現状のコードは以下の通りです。
Private Sub UserForm_Initialize()
Dim txtpath As String
Dim txtstr As String
Dim spA As Variant
Dim spB As Variant
Dim i As Integer
Dim j As Integer
Dim lbary() As Variant
Dim RowNum As Long
Dim clcnt As Integer
Dim gyoutabnum As Integer
'読込むテキストファイルの指定
txtpath = ThisWorkbook.Path & "\aaa.txt"
'テキストファイルの内容取得(Function呼び出し)
txtstr = txtget(txtpath)
'最大Tab区切り数取得(Function呼び出し)
clcnt = TabMax(txtstr)
'テキストファイル内容を改行(VbCrLf)でSplit
spA = Split(txtstr, vbCrLf)
RowNum = UBound(spA)
'配列の列数・行数を設定
ReDim lbary(clcnt, RowNum)
For i = 0 To UBound(spA)
'各行の内容をTabでSplit
spB = Split(spA(i), vbTab)
gyoutabnum = UBound(spB)
For j = 0 To gyoutabnum
'Tabで区切ったものを配列に格納
lbary(j, i) = spB(j)
Next j
Next i
'配列の内容をリストボックスに格納
Me.ListBox1.ColumnCount = clcnt - 1
Me.ListBox1.Column = lbary
Erase lbary
End Sub
'最大Tab区切り数を取得するFunction
Function TabMax(ByVal txtstr As String) As Integer
Dim spA As Variant
Dim spB As Variant
Dim gyoutabnum As Integer
Dim i As Long
'文字列をVbCrlfでSplit
spA = Split(txtstr, vbCrLf)
'tabmax(最大Tab区切り数)の初期化)
tabmaxget = 0
For i = 0 To UBound(spA)
'各行の文字列をVbCrlfでSplit
spB = Split(spA(i), vbTab)
'各行のTab区切り数を取得
gyoutabnum = UBound(spB)
'各行のTab区切り数がtabmax(最大Tab区切り数)より大きかったら
'tabmaxに各行のTab区切り数を再格納
If gyoutabnum > TabMax Then TabMax = gyoutabnum
Next i
End Function
'テキストファイル内容を取得するFunction
Function txtget(ByVal txtpath As String)
Dim FSO As Object
Dim f As Object
Dim txtstr As String
Set FSO = CreateObject("Scripting.FileSystemObject")
Set f = FSO.OpenTextFile(txtpath)
If FSO.getfile(txtpath).Size = 0 Then
txtget = ""
Else
txtget = f.ReadAll
End If
Set FSO = Nothing
End Function
私なら、テキストファイルウィザードでシートに展開して RowSourceプロパティに展開した範囲を指定しちゃいます。 （みやほりん）
みやほりんさん、ご回答ありがとうございます。
下記のコードでテキストファイルの内容を一括でリストボックスに格納することは出来ました。
Private Sub CommandButton1_Click() Dim fpath As String Dim wb As Workbook Dim r As Range Me.ListBox1.Clear fpath = ThisWorkbook.Path & "\aaa.txt" Application.ScreenUpdating = False Workbooks.OpenText Filename:=fpath, DataType:=xlDelimited, Comma:=True Set wb = ActiveWorkbook Set r = ActiveSheet.UsedRange Me.ListBox1.List = r.Value Me.ListBox1.ColumnCount = r.Columns.Count wb.Close , False Application.ScreenUpdating = True Set r = Nothing Set wb = Nothing End Sub
やはり一度シートに展開する方法しかないようですね。 メモリ上で一発で最大タブ区切り数を取得する方法は無いかなと思ったのですが無い ようですね。
メモリ上で取得できたら他の事にも応用できそうでしたが取得出来ないので他のアプローチ を考えてみます。
ありがとうございました。
(カシスソーダ)
>やはり一度シートに展開する方法しかないようですね。 >メモリ上で一発で最大タブ区切り数を取得する方法は無いかなと思ったのですが無い >ようですね。
ADOを使えば可能ですが、大きくは変わらないと思いますよ
新規ブックを作成してください。 UserForm1を作成し、リストボックス（ListBox1）を一つ配置してください。
標準モジュール（Module1）にADO関連プロシジャー群
'======================================================
Private cn As Object
'=============================================================
Function open_ado_text(path As String) As Long 'adoでテキストにアクセス
On Error Resume Next
Dim link_opt As String
Set cn = CreateObject("adodb.connection")
link_opt = "Driver={Microsoft Text Driver (*.txt; *.csv)};" & _
"DBQ=" & path & ";" & "ReadOnly=0"
cn.Open link_opt
open_ado_text = Err.Number
On Error GoTo 0
End Function
'=============================================================
Sub close_ado() 'クローズ
On Error Resume Next
cn.Close
Set cn = Nothing
On Error GoTo 0
End Sub
'=============================================================
Function exec_sql(sql_str, Optional rs As Variant) As Long 'Sqlの実行
On Error Resume Next
If IsMissing(rs) Then
cn.Execute sql_str
Else
Set rs = cn.Execute(sql_str)
End If
exec_sql = Err.Number
'If Err.Number <> 0 Then MsgBox Err.Description
On Error GoTo 0
End Function
'==========================================================================
Function mk_schema_ini(path As String, dat() As String) As Long
'schema.iniの作成
On Error GoTo err_mk_schema_ini
Dim fno As Long
Dim didx As Long
mk_schema_ini = 0
fno = FreeFile()
Open path & "\schema.ini" For Output As #fno
For didx = LBound(dat()) To UBound(dat())
Print #fno, dat(didx)
Next
Close #fno
ret_mk_schema_ini:
On Error GoTo 0
Exit Function
err_mk_schema_ini:
MsgBox Err.Description
mk_schema_ini = Err.Number
Resume ret_mk_schema_ini
End Function
'=============================================================
Function del_schema_ini(path As String) 'schema_iniの削除
On Error Resume Next
Kill path & "\schema.ini"
On Error GoTo 0
End Function
別の標準モジュール（Module2）にテキストファイルをListbox1に登録し、表示するプロシジャー
'==============================================================
Sub test()
Dim ret As Long
Dim dat(1 To 4) As String
Dim rs As Object
Dim ans As Variant
dat(1) = "[smp.txt]"
dat(2) = "ColNameHeader = false"
dat(3) = "CharacterSet = oem"
dat(4) = "Format = TabDelimited"
Call mk_schema_ini(ThisWorkbook.path, dat())
ret = open_ado_text(ThisWorkbook.path)
If ret = 0 Then
ret = exec_sql("select * from smp.txt", rs)
If ret = 0 Then
With UserForm1
.ListBox1.ColumnCount = rs.Fields.Count
.ListBox1.Column = rs.GetRows
.Show
End With
Else
MsgBox Error(ret)
End If
rs.Close
close_ado
End If
Call del_schema_ini(ThisWorkbook.path)
Erase dat()
Set rs = Nothing
End Sub
上記ブックは、対象のテキストファイル（ファイル名 smp.txt、タブ区切りでヘッダーなしの例）と 同じフォルダ上に保存した上で実行してみてください。
ファイル名が違うならコード解析の上変更してください
ichinose
ichinoseさん、ご回答ありがとうございます。
>Sub test() ↑の > With UserForm1 > .ListBox1.ColumnCount = rs.Fields.Count > .ListBox1.Column = rs.GetRows > .Show > End With
の
>rs.Fields.Count
が最大Tab区切り数になるということですね。 ありがとうございました。
(カシスソーダ)
[ 一覧(最新更新順) ]
YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki.
Modified by kazu.