| |
EXCEL_VBA中の下 さん、
ponponさん、こんばんは。
>データシート
というシート名を持ったシートに
以下のデータがセルＡ列からＤ列の１行目から入っているとします。
> 大分類、 中分類、 小分類、金額
> 服、 紳士服、 紳士服、500
> 服、 婦人服、 婦人服、400
> 服、 子供服、 子供服、300
> 本、 マンガ、 男子向、100
> 本、 マンガ、 女子向、150
> 飲み物、ジュース、 オレンジ、110
> 飲み物、ジュース、 アップル、115
> 飲み物、ジュース、 パイン 、120
> 飲み物、 お茶系、 麦茶、100
> 飲み物、 お茶系、ウーロン茶、100
>
>
>結果シート
というシート名を持ったシートを作成して置いてください。
>SQLでの記述方法がわかれば多分、
>「SELECT 大分類、中分類、SUM(金額） FROM データシート
> GROUP BY 大分類、中分類」と「FETCH？」
これは、色んな方法があると思いますが、
いけそうなＳＱＬが記述されているので
これを使いましょう！！
上記の二つのシートを持ったブックの
標準モジュールに
'=======================================================
Sub test()
Dim rs As Object
Dim mysql As String
If open_ado_excel(ThisWorkbook.FullName) = 0 Then
mysql = "select [大分類],[中分類],sum([金額]) from [データシート$] group by [大分類],[中分類]"
If get_exec_sql(mysql, rs) = 0 Then
With Worksheets("結果シート")
.Cells.ClearContents
.Range("a1").CopyFromRecordset rs
.Range("a1:c1").Value = Array("大分類", "中分類", "金額")
End With
Call rs_close(rs)
Else
MsgBox "rs error"
End If
Call close_ado
Else
MsgBox "cn error"
End If
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
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 get_exec_sql(sql_str, rs As Object) As Long
On Error Resume Next
Set rs = cn.Execute(sql_str)
get_exec_sql = Err.Number
On Error GoTo 0
End Function
'======================================================
Sub rs_close(rs As Object)
On Error Resume Next
rs.Close
On Error GoTo 0
End Sub
以上です。
一度このブックを保存してから
プロシジャーtestを実行して見て下さい。
|
|
ichinose
- 05/9/1(木) 22:59 -
