| |
▼EXCEL_VBA中の下 さん：
こんばんは。
私もやってみました。
実験 １
新規ブックのSheet1のセルＡ１から
Ａ Ｂ Ｃ Ｄ
１ 大分類 中分類 小分類 金額
２ 服 紳士服 紳士服 500
３ 服 婦人服 婦人服 400
４ 服 子供服 子供服 300
５ 本 マンガ 男子向 100
６ 本 マンガ 女子向 150
７ 飲み物 ジュース オレンジ 110
８ 飲み物 ジュース アップル 115
９ 飲み物 ジュース パイン 120
１０ 飲み物 お茶系 麦茶 100
１１ 飲み物 お茶系 ウーロン茶 100
というEXCEL_VBA中の下 さんがご提示されたサンプルデータを
使用します。
Sheet2という名前のシートも用意してください
このブックの標準モジュールに
'===========================================================
Sub main()
Dim flno As Long
Dim idx As Long
flno = FreeFile()
Open ThisWorkbook.Path & "\memlog.csv" For Output As #flno
Print #flno, "ＮＯ,使用メモリー,空きメモリー,トータル"
For idx = 1 To 100
Call test
DoEvents
With Application
Print #flno, idx & "," & .MemoryUsed & "," & .MemoryFree & "," & .MemoryTotal
End With
Next idx
Close #flno
End Sub
'========================================================================
Sub test()
Dim rs As Object
Dim mysql As String
If open_ado_excel(ThisWorkbook.FullName) = 0 Then
mysql = "select [大分類],[中分類],sum([金額]) from [sheet1$] group by [大分類],[中分類]"
If get_exec_sql(mysql, rs) = 0 Then
With Worksheets("sheet2")
.Cells.ClearContents
.Range("a2").CopyFromRecordset rs
.Range("a1:c1").Value = Array("大分類", "中分類", "金額")
End With
End If
Call rs_close(rs)
End If
Call close_ado
End Sub
別の標準モジュールに
'===============================================================
Public cn As Object
'======================================================
Function open_ado_excel(book_fullname As String) As Long
On Error Resume Next
link_opt = "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=" & book_fullname & ";" & _
"Extended Properties=Excel 8.0;"
Set cn = CreateObject("ADODB.Connection")
cn.Open link_opt
If Err.Number <> 0 Then
MsgBox Err.Number & ":::" & Err.Description
End If
open_ado_excel = 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 get_exec_sql(sql_str, rs As Object) As Long
On Error Resume Next
Set rs = cn.Execute(sql_str)
If Err.Number <> 0 Then
MsgBox Err.Number & ":::" & Err.Description
End If
get_exec_sql = Err.Number
On Error GoTo 0
End Function
'======================================================
Sub rs_close(rs As Object)
On Error Resume Next
rs.Close
Set rs = Nothing
On Error GoTo 0
End Sub
と細かいところをちょっと更新しました。
これを適当なブック名を付けて保存した後、
プロシジャーmainを実行してください。
ブックと同じフォルダにmemlog.csvというログファイルを
作成します。
mainの実行後、呼び出してください。
cvsファイルになっていますからExcelで読み込めるはずです。
ログファイルを見ると使用メモリーが増えています。
これでは、困りますよねえ！！
さあ、どうしよう・・・・。
|
|
ichinose
- 05/9/6(火) 20:28 -
