| |
こんばんは。
どうしてExcelのSortでは駄目なのですか？
ソートのアルゴリズムを習得することは良いことですが、
私はＶＢＡをはじめてからソートのコードを書いたことがありません。
ＡＤＯを使用して読み込み時にソートしてしまう方法です。
>txtﾌｧｲﾙに
>8:00,起床
>1:00,就寝
>12:00,昼食
>10:00,学習
↑このデータがマクロを含むブックと同じフォルダにあるとして
（sample.txtという名前を例にしました）
標準モジュールに
'===============================================================
Private cn As Object 'コネクションオブジェクト
'===============================================================
Function open_ado_text(path As String) As Long
'テキストファイルにＡＤＯで接続する
'Input: path---テキストファイルがあるフォルダ
On Error Resume Next
Set cn = CreateObject("adodb.connection")
link_opt = "Driver={Microsoft Text Driver (*.txt; *.csv)};" & _
"DBQ=" & path & ";" & "ReadOnly=0"
cn.Open link_opt
open_ado_excel = Err.Number
On Error GoTo 0
End Function
'=====================================================
Sub close_ado()
'ＡＤＯの切断
On Error Resume Next
cn.Close
On Error GoTo 0
End Sub
'=====================================================
Function exec_sql(sql_str, rs As Object) As Long
'レコードセットを取得するSQLを実行する
'input sql---実行するsql
'output rs---レコードセット
' exec_sql--0--ok Other--NG
On Error Resume Next
Set rs = cn.Execute(sql_str)
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
別の標準モジュールに
'===========================================================
Sub main()
Dim ret As Long
Dim dat(1 To 6) As String
Dim rs As object
Dim ans As Variant
dat(1) = "[sample.txt]"
' ↑ﾃｷｽﾄﾌｧｲﾙ名前を指定
dat(2) = "ColNameHeader = False"
dat(3) = "CharacterSet = oem"
dat(4) = "Format = CSVDelimited"
dat(5) = "Col1=f1 date"
dat(6) = "Col2=f2 char width 255"
Call mk_schema_ini(ThisWorkbook.path, dat())
ret = open_ado_text(ThisWorkbook.path)
If ret = 0 Then
ret = exec_sql("select * from sample.txt order by f1", rs)
' ↑ﾃｷｽﾄﾌｧｲﾙ名前を指定
If ret = 0 Then
ans = Application.Transpose(rs.GetRows)
For idx = LBound(ans, 1) To UBound(ans, 1)
MsgBox Format(ans(idx, 1), "h:mm") & "---" & ans(idx, 2)
Next
rs.Close
Else
MsgBox Error(ret)
End If
close_ado
End If
Call del_schema_ini(ThisWorkbook.path)
End Sub
としてmainを実行してみてください。
ソートのアルゴリズムの勉強も兼ねていたなら失礼です。
|
|
ichinose
- 06/2/8(水) 18:42 -
