Excel VBA質問箱 IV

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

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


	新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃過去ログ ┃ホーム

56603 / 76732

←次へ　｜　前へ→


	【24879】Re:アクセスデータの集計

小僧 - 05/5/12(木) 13:26 -


	引用なし

	パスワード

▼さつきさん：
こんにちは。
何とかして集計に合計を加えたSQLを一括でできないか色々悩んでいたのですが、
こんな感じでいかがでしょうか？

Sub 集計3()
Dim SQLCode As String
Dim cnn As New ADODB.Connection
Dim rst As New ADODB.Recordset
Dim dbName As String
Dim Kiten As Range
Dim Cnt As Long
Dim Num As Long
Dim Ten As String
Dim Kei As String
Dim Syu As String
Dim Tan As String
　　
'DBの設定
　　dbName = "C:週報.mdb"

'起点の設定
　　Set Kiten = Range("B2")
　　
'集計クエリのSQL文を作成
　　SQLCode = "SELECT Q.* " _
　　　　　　& "FROM [ " _
　　　　　　& "TRANSFORM Count(累計.品名) AS 品名のカウント " _
　　　　　　& "SELECT 累計.店名, 累計.契約者名, 累計.担当者名 " _
　　　　　　& "FROM 累計 " _
　　　　　　& "GROUP BY 累計.店名, 累計.契約者名, 累計.担当者名 " _
　　　　　　& "PIVOT 累計.週 " _
　　　　　　& "IN ('S1','S2','S3','S4','S5') " _
　　　　　　& "]. AS Q " _
　　　　　　& "UNION ALL SELECT T.* " _
　　　　　　& "FROM [ " _
　　　　　　& "TRANSFORM Count(累計.品名) AS 品名のカウント " _
　　　　　　& "SELECT 累計.店名, '' AS 契約者名, '合計' AS 担当者名 " _
　　　　　　& "FROM 累計 " _
　　　　　　& "GROUP BY 累計.店名, '', '合計' " _
　　　　　　& "PIVOT 累計.週 " _
　　　　　　& "IN ('S1','S2','S3','S4','S5') " _
　　　　　　& "]. AS T " _
　　　　　　& "ORDER BY 店名 ,契約者名 DESC;"

'ADOでSQLを実行
　　cnn.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;" _
　　　　　　　　　　　　 & "Data Source=" & dbName
　　cnn.Open
　　
'下行のコメントを外すとイミディエトウィンドウにSQLを表示
　　'Debug.Print SQLCode
　　rst.Open SQLCode, cnn

'フィールド名を起点の列に挿入
　　For Cnt = 0 To rst.Fields.Count - 1
　　　　Kiten.Offset(0, Cnt).Value = rst(Cnt).Name
　　Next
　　　　Kiten.Offset(0, rst.Fields.Count).Value = "品名"
　　
'データの貼り付け
　　Kiten.Offset(1, 0).CopyFromRecordset rst
　　rst.Close

'店名のフィールドが空になるまで
　　For Cnt = Kiten.Row + 1 To Kiten.End(xlDown).Row
　　　　
'「合計」の行はスキップ
　　　　If Cells(Cnt, Kiten.Column + 2) <> "合計" Then

'「S1」～「S5」までをループ
　　　　　　For Num = Kiten.Column + 3 To Kiten.Column + 7
　　　　　　　　
'値が入っているフィールドが見つかったら変数「Syu」にフィールド名を入力
　　　　　　　　If Not (IsEmpty(Cells(Cnt, Num).Value)) Then
　　　　　　　　　　Syu = Cells(Kiten.Row, Num).Value: Exit For
　　　　　　　　End If
　　　　　　Next

　　　　　　SQLCode = "SELECT 累計.品名 " _
　　　　　　　　　　& "FROM 累計 " _
　　　　　　　　　　& "WHERE 店名 = '" & Cells(Cnt, Kiten.Column).Value & "' AND " _
　　　　　　　　　　　　　& "契約者名 = '" & Cells(Cnt, Kiten.Column + 1).Value & "' AND " _
　　　　　　　　　　　　　& "担当者名 = '" & Cells(Cnt, Kiten.Column + 2) & "' AND " _
　　　　　　　　　　　　　& "週 = '" & Syu & "'"

'下行のコメントを外すとイミディエトウィンドウにSQLを表示
　　　　　　'Debug.Print SQLCode
　　　　　　rst.Open SQLCode, cnn
　　　　　　
'品名がある限りループして「品名」フィールドに追加
　　　　　　Do Until rst.EOF
　　　　　　　　Cells(Cnt, Kiten.Column + 8) = Cells(Cnt, Kiten.Column + 8) & " " & rst![品名]
　　　　　　　　rst.MoveNext
　　　　　　Loop
　　　　rst.Close
　　　 End If
　　Next
　　
'オブジェクトの解放
　　Set rst = Nothing
　　cnn.Close
　　Set cnn = Nothing
　　
　　Kiten.Offset(0, 8).Columns.EntireColumn.AutoFit
　　Set Kiten = Nothing
End Sub

累計テーブルの「週」フィールドが文字型の「S1」,「S2」というような値であれば
うまくいくと思います。

0 hits

▼

【24563】アクセスデータの集計 さつき 05/4/26(火) 15:29