Excel VBA質問箱 IV

当質問箱は、有志のボランティア精神のおかげで成り立っています。
問題が解決したら、必ずお礼をしましょうね。
本サイトの基本方針をまとめました。こちら をご一読ください。

投稿種別の選択が必要です。ご注意ください。
迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。


53271 / 76732 ←次へ | 前へ→

【28279】Re:とある条件のレコードだけ合計が必要な場合
発言  ichinose  - 05/9/1(木) 22:59 -

引用なし
パスワード
   EXCEL_VBA中の下 さん、
ponponさん、こんばんは。


>データシート
というシート名を持ったシートに
以下のデータがセルA列からD列の1行目から入っているとします。

> 大分類、 中分類、  小分類、金額
>   服、 紳士服、  紳士服、500
>   服、 婦人服、  婦人服、400
>   服、 子供服、  子供服、300
>   本、 マンガ、  男子向、100
>   本、 マンガ、  女子向、150
> 飲み物、ジュース、 オレンジ、110
> 飲み物、ジュース、 アップル、115
> 飲み物、ジュース、 パイン 、120
> 飲み物、 お茶系、   麦茶、100
> 飲み物、 お茶系、ウーロン茶、100
>

>
>結果シート
というシート名を持ったシートを作成して置いてください。


>SQLでの記述方法がわかれば多分、
>「SELECT 大分類、中分類、SUM(金額) FROM データシート
> GROUP BY 大分類、中分類」と「FETCH?」
これは、色んな方法があると思いますが、
いけそうなSQLが記述されているので
これを使いましょう!!

上記の二つのシートを持ったブックの
標準モジュールに

'=======================================================
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を実行して見て下さい。
0 hits

【28269】とある条件のレコードだけ合計が必要な場合 EXCEL_VBA中の下 05/9/1(木) 18:35 質問
【28272】Re:とある条件のレコードだけ合計が必要な... ponpon 05/9/1(木) 20:39 発言
【28279】Re:とある条件のレコードだけ合計が必要な... ichinose 05/9/1(木) 22:59 発言
【28390】Re:とある条件のレコードだけ合計が必要な... EXCEL_VBA中の下 05/9/5(月) 10:59 発言
【28392】Re:とある条件のレコードだけ合計が必要な... ichinose 05/9/5(月) 12:03 発言
【28393】Re:とある条件のレコードだけ合計が必要な... EXCEL_VBA中の下 05/9/5(月) 13:37 お礼

53271 / 76732 ←次へ | 前へ→
ページ:  ┃  記事番号:
2610219
(SS)C-BOARD v3.8 is Free