スポンサーサイト 


上記の広告は1ヶ月以上更新のないブログに表示されています。
新しい記事を書く事で広告が消せます。

--/--/--

Category: スポンサー広告

TB: --  /  CM: --

top △

クロス集計のExcel出力 


クロス集計をやっていると、どうしようもない「列」が出来上がる事があります。
例えば、テーブル「TA」が以下の様なものになっているとします。

an売上年月営業所商品数量重量売上金額
12013/08東京AAA15500
22013/07名古屋AAA2101000
32013/08東京BBB330900
42013/06東京CCC4504000
52013/05大阪AAA5252500
62013/08東京CCC6506000
72013/07大阪AAA7353500
82013/08東京AAA8404000
92013/06名古屋BBB9902700
102013/08東京AAA10505000

このデータを元に、
・「営業所」「商品」でグループ化
・「売上年月」をキーとして、各「数量」「重量」「売上金額」の合計を

以下の内容の、テーブル「TB」を作成し、
IDF1
1_1数計
2_2重計
3_3売計

以下をクエリの SQL ビューに記述すると
TRANSFORM Sum(Choose(Q2.ID,Q1.数量,Q1.重量,Q1.売上金額)) AS 値
SELECT Q1.営業所, Q1.商品
FROM TA AS Q1, TB AS Q2
GROUP BY Q1.営業所, Q1.商品
PIVOT Q1.売上年月 & Q2.F1;

以下の結果が得られます。
kEnt170_2

ただ、この時・・・
・「営業所」「商品」の全組合せで一覧を・・・・

TRANSFORM Sum(Choose(Q1.ID,Q2.数量,Q2.重量,Q2.売上金額)) AS 値
SELECT Q1.営業所, Q1.商品
FROM (SELECT T1.営業所, T2.商品, TB.ID, TB.F1 FROM
(SELECT DISTINCT 営業所 FROM TA) AS T1, (SELECT DISTINCT 商品 FROM TA) AS T2, TB
) AS Q1 LEFT JOIN TA AS Q2 ON (Q1.商品=Q2.商品) AND (Q1.営業所=Q2.営業所)
GROUP BY Q1.営業所, Q1.商品
PIVOT Q2.売上年月 & Q1.F1;

でやると、全組合せはできますが・・・・「列」部分に不要なものが出てきます。
(テーブル「TB」の「F1」に設定した文字列)
kEnt170_4

これは、クロス集計時に全組合せを処理対象にさせたから・・・・
※ PIVOT Q2.売上年月 & Q1.F1; この部分がそうですが・・・・
 全組合せにした為に「売上年月」が Null  これが存在するようになったから・・・
 もちろん、元データが全組合せ分存在するのなら、出現しない列になります

では、クロス集計時にはそのまま作らせておいて、できたものと全組合せを結び付けましょうか・・・・
冒頭で記述したクロス集計のクエリ名を「★★」とした場合、

SELECT * FROM
(SELECT T1.営業所, T2.商品 FROM
(SELECT DISTINCT 営業所 FROM TA) AS T1, (SELECT DISTINCT 商品 FROM TA) AS T2
) AS Q1 LEFT JOIN ★★ AS Q2 ON (Q1.商品=Q2.商品) AND (Q1.営業所=Q2.営業所)
ORDER BY Q1.営業所, Q1.商品;

で、結果は
kEnt170_6

SELECT * FROM
としている時点で、こういう表示になりますね・・・・
表示するものをクエリのデザインで選べばよいのかもしれませんが・・・・
そうなると、クロス集計の恩恵が薄れる様な気も・・・・
何故って・・・
 クロス集計で出来上がった列も明示的に表示する指定をする事になるんですよね・・・
 じゃ、その列が増減したら・・・・その都度変更するの???

処理性能的には、後者の方が速そうな気はするけど・・・・ 今回、測定しません。


ま、これら不要な列は出力時に何とかしましょう・・・・
出力先を Excel とした時のサンプルになると思います。

また、せっかくなので、Excel 出力時に色気を出してみましょうか・・・・

kEnt170

kEnt170_4
     ↓
kEnt170_5  kEnt170_51  kEnt170_52
 
まず、基本的な Excel 出力部分を標準モジュールに記述しておきます。
Const xlThin = 2
Const xlCenter = -4108
Const xlCellTypeLastCell = 11

Public Sub PtnToExcel(sQ As String)
  Dim rs As New ADODB.Recordset
  Dim i As Long, iCol As Long
  Dim sS As String

  rs.Open sQ, CurrentProject.Connection, adOpenForwardOnly, adLockReadOnly
  If (Not rs.EOF) Then
    With CreateObject("Excel.Application")
      .WorkBooks.Add
      For i = 0 To rs.Fields.Count - 1
        .Cells(1, i + 1) = rs(i).Name
      Next
      .Cells(2, 1).CopyFromRecordset rs
      With .Range("A1").CurrentRegion
        .Borders.Weight = xlThin
        .EntireColumn.AutoFit
      End With
      .Visible = True
    End With
  End If
  rs.Close
End Sub

 
Excel で使用する定数部分を定義しておいて、
テーブル名・クエリ名を受け取ったら、レコードセットを得ておいて・・・・
レコードがあったら、Excel を起動し、新規ブックに・・・・
 "A1" から右にフィールド名を転記後
 "A2" で CopyFromRecordset を使ってデータを転記
 書き出した範囲に、枠線引いて・・・・ 列幅詰めて・・・・
処理が終わったので、Excel を表示して終わり

用意したクエリを順次 Excel へ出力していきます。


クエリ「Q_PTN_1」

クロス集計時、列名は「売上年月」とし、各「数量」「重量」「売上金額」の合計を文字列として繋げる

クエリの SQL ビュー
TRANSFORM Sum(数量) & " " & Sum(重量) & " " & Sum(売上金額) AS 値
SELECT 営業所, 商品
FROM TA
GROUP BY 営業所, 商品
PIVOT 売上年月;

Call PtnToExcel("Q_PTN_1") で出力した結果は以下
kEnt170_1


クエリ「Q_PTN_2」

クロス集計時、列名は「売上年月」をキーとして、各「数量」「重量」「売上金額」の合計を別の列とする
テーブル「TB」も利用

クエリの SQL ビュー
TRANSFORM Sum(Choose(Q2.ID,Q1.数量,Q1.重量,Q1.売上金額)) AS 値
SELECT Q1.営業所, Q1.商品
FROM TA AS Q1, TB AS Q2
GROUP BY Q1.営業所, Q1.商品
PIVOT Q1.売上年月 & Q2.F1;

Call PtnToExcel("Q_PTN_2") で出力した結果は以下
kEnt170_2


クエリ「Q_PTN_3」

クロス集計時、列名は「売上年月」とし、各「数量」「重量」「売上金額」の合計を文字列として繋げる
とともに、「営業所」「商品」を全組合せとする

クエリの SQL ビュー
TRANSFORM Sum(Q2.数量) & " " & Sum(Q2.重量) & " " & Sum(Q2.売上金額) AS 値
SELECT Q1.営業所, Q1.商品 FROM
(SELECT T1.営業所, T2.商品 FROM
(SELECT DISTINCT 営業所 FROM TA) AS T1, (SELECT DISTINCT 商品 FROM TA) AS T2
) AS Q1 LEFT JOIN TA AS Q2 ON (Q1.営業所=Q2.営業所) AND (Q1.商品=Q2.商品)
GROUP BY Q1.営業所, Q1.商品
PIVOT Q2.売上年月;

Call PtnToExcel("Q_PTN_3") で出力した結果は以下
kEnt170_3


クエリ「Q_PTN_4」

クロス集計時、列名は「売上年月」をキーとして、各「数量」「重量」「売上金額」の合計を別の列とする
テーブル「TB」も利用
とともに、「営業所」「商品」を全組合せとする

事前に用意しておくクエリ「Q_ZEN」の SQL ビュー
SELECT Q1.営業所, Q1.商品, Q2.売上年月, Q2.数量, Q2.重量, Q2.売上金額 FROM
(SELECT T1.営業所, T2.商品 FROM
(SELECT DISTINCT 営業所 FROM TA) AS T1, (SELECT DISTINCT 商品 FROM TA) AS T2
) AS Q1 LEFT JOIN TA AS Q2 ON (Q1.営業所=Q2.営業所) AND (Q1.商品=Q2.商品);


クエリの SQL ビュー
TRANSFORM Sum(Choose(Q2.ID,Q1.数量,Q1.重量,Q1.売上金額)) AS 値
SELECT Q1.営業所, Q1.商品
FROM Q_ZEN AS Q1, TB AS Q2
GROUP BY Q1.営業所, Q1.商品
PIVOT Q1.売上年月 & Q2.F1;

Call PtnToExcel("Q_PTN_4") で出力した結果は以下
kEnt170_4


クエリ「Q_PTN_5」

クエリ「Q_PTN_4」での、事前に用意しておくクエリ「Q_ZEN」を使わないバージョン

クエリの SQL ビュー
TRANSFORM Sum(Choose(Q1.ID,Q2.数量,Q2.重量,Q2.売上金額)) AS 値
SELECT Q1.営業所, Q1.商品 FROM
(SELECT T1.営業所, T2.商品, TB.ID, TB.F1 FROM
(SELECT DISTINCT 営業所 FROM TA) AS T1, (SELECT DISTINCT 商品 FROM TA) AS T2, TB
) AS Q1 LEFT JOIN TA AS Q2 ON (Q1.営業所=Q2.営業所) AND (Q1.商品=Q2.商品)
GROUP BY Q1.営業所, Q1.商品
PIVOT Q2.売上年月 & Q1.F1;

Call PtnToExcel("Q_PTN_5") で出力した結果は以下
kEnt170_4


Excel に出力しつつ、項目(フィールド名)部分に手を入れてみる。

Excel に転記した後、
・列C ~ 列E に不要なものがあるので、列ごと削除
・項目を記述した1行目に行挿入
・「数計」「重計」「売計」の3つ単位で、
 ・1行目に「売上年月」をセル結合して
 ・「数計」「重計」「売計」の文字列は "_" を探して・・・
・最後にセル幅を詰めて
kEnt170_5

これを記述してみると
Public Sub PTN_5_2()
  Dim rs As New ADODB.Recordset
  Dim i As Long, iCol As Long
  Dim sS As String

  rs.Open "Q_PTN_5", CurrentProject.Connection, adOpenForwardOnly, adLockReadOnly
  If (Not rs.EOF) Then
    With CreateObject("Excel.Application")
      .WorkBooks.Add
      For i = 0 To rs.Fields.Count - 1
        .Cells(1, i + 1) = rs(i).Name
      Next
      .Cells(2, 1).CopyFromRecordset rs
      .Range("A1").CurrentRegion.Borders.Weight = xlThin
      .Columns("C:E").Delete
      .Rows(1).HorizontalAlignment = xlCenter
      .Rows(1).Insert
      iCol = 3
      While (.Cells(2, iCol) <> "")
        sS = .Cells(2, iCol)
        sS = Left(sS, InStr(sS, "_") - 1)
        With .Range(.Cells(1, iCol), .Cells(1, iCol + 2))
          .Merge
          .HorizontalAlignment = xlCenter
          .NumberFormatLocal = "@"
          .Value = sS
          .Borders.Weight = xlThin
        End With
        For i = 0 To 2
          sS = .Cells(2, iCol + i)
          .Cells(2, iCol + i) = Mid(sS, InStr(sS, "_") + 2)
        Next
        iCol = iCol + 3
      Wend
      .Range("A2").CurrentRegion.EntireColumn.AutoFit
      .Visible = True
    End With
  End If
  rs.Close
End Sub

 

上記で基本的な整形ができたので、
・右側に「数計」「重計」「売計」の総計を SUMIF 関数を埋め込んで
・表の下側に、各「数計」「重計」「売計」の合計を出すように SUM 関数を埋め込んで
kEnt170_51

これを追加記述してみると
Public Sub PTN_5_3()
  Dim rs As New ADODB.Recordset
  Dim i As Long, iRow As Long, iCol As Long
  Dim sS As String

  rs.Open "Q_PTN_5", CurrentProject.Connection, adOpenForwardOnly, adLockReadOnly
  If (Not rs.EOF) Then
    With CreateObject("Excel.Application")
      .WorkBooks.Add
      For i = 0 To rs.Fields.Count - 1
        .Cells(1, i + 1) = rs(i).Name
      Next
      .Cells(2, 1).CopyFromRecordset rs
      .Range("A1").CurrentRegion.Borders.Weight = xlThin
      .Columns("C:E").Delete
      .Rows(1).HorizontalAlignment = xlCenter
      .Rows(1).Insert
      iCol = 3
      While (.Cells(2, iCol) <> "")
        sS = .Cells(2, iCol)
        sS = Left(sS, InStr(sS, "_") - 1)
        With .Range(.Cells(1, iCol), .Cells(1, iCol + 2))
          .Merge
          .HorizontalAlignment = xlCenter
          .NumberFormatLocal = "@"
          .Value = sS
          .Borders.Weight = xlThin
        End With
        For i = 0 To 2
          sS = .Cells(2, iCol + i)
          .Cells(2, iCol + i) = Mid(sS, InStr(sS, "_") + 2)
        Next
        iCol = iCol + 3
      Wend

      iRow = .Range("A2").CurrentRegion.SpecialCells(xlCellTypeLastCell).Row
      sS = "C" & iCol - 1
      For i = 0 To 2
        .Cells(2, iCol + i) = "総計:" & .Cells(2, i + 3)
        With .Range(.Cells(3, iCol + i), .Cells(iRow, iCol + i))
          .FormulaR1C1 = "=SUMIF(R2C3:R2" & sS & ",R2C" & i + 3 & ",RC3:R" & sS & ")"
        End With
      Next
      .Range(.Cells(2, iCol), .Cells(iRow, iCol + 2)).Borders.Weight = xlThin
      With .Range(.Cells(iRow + 1, 3), .Cells(iRow + 1, iCol + 2))
        .FormulaR1C1 = "=SUM(R3C:R[-1]C)"
        .Borders.Weight = xlThin
      End With


      .Range("A2").CurrentRegion.EntireColumn.AutoFit
      .Visible = True
    End With
  End If
  rs.Close
End Sub

 

上記で計算式の埋め込みが出来たけど、
・右側に追加した「数計」「重計」「売計」の総計部分・・・
 0 の表示はいらないよね
という事で、その行の範囲にデータがあるか COUNTA でみて SUMIF するように・・・
また、不要列があるかどうか・・・判別を追加してみる
kEnt170_52

これを変更してみると
Public Sub PTN_5_4()
  Dim rs As New ADODB.Recordset
  Dim i As Long, iRow As Long, iCol As Long
  Dim sS As String

  rs.Open "Q_PTN_5", CurrentProject.Connection, adOpenForwardOnly, adLockReadOnly
  If (Not rs.EOF) Then
    With CreateObject("Excel.Application")
      .WorkBooks.Add
      For i = 0 To rs.Fields.Count - 1
        .Cells(1, i + 1) = rs(i).Name
      Next
      .Cells(2, 1).CopyFromRecordset rs
      .Range("A1").CurrentRegion.Borders.Weight = xlThin
      If (.Range("C1") Like "_*") Then .Columns("C:E").Delete
      .Rows(1).HorizontalAlignment = xlCenter
      .Rows(1).Insert
      iCol = 3
      While (.Cells(2, iCol) <> "")
        sS = .Cells(2, iCol)
        sS = Left(sS, InStr(sS, "_") - 1)
        With .Range(.Cells(1, iCol), .Cells(1, iCol + 2))
          .Merge
          .HorizontalAlignment = xlCenter
          .NumberFormatLocal = "@"
          .Value = sS
          .Borders.Weight = xlThin
        End With
        For i = 0 To 2
          sS = .Cells(2, iCol + i)
          .Cells(2, iCol + i) = Mid(sS, InStr(sS, "_") + 2)
        Next
        iCol = iCol + 3
      Wend

      iRow = .Range("A2").CurrentRegion.SpecialCells(xlCellTypeLastCell).Row
      sS = "C" & iCol - 1
      For i = 0 To 2
        .Cells(2, iCol + i) = "総計:" & .Cells(2, i + 3)
        With .Range(.Cells(3, iCol + i), .Cells(iRow, iCol + i))
          .FormulaR1C1 = "=IF(COUNTA(RC3:R" & sS & ")=0,""""," _
                  & "SUMIF(R2C3:R2" & sS & ",R2C" & i + 3 & ",RC3:R" & sS & "))"

        End With
      Next
      .Range(.Cells(2, iCol), .Cells(iRow, iCol + 2)).Borders.Weight = xlThin
      With .Range(.Cells(iRow + 1, 3), .Cells(iRow + 1, iCol + 2))
        .FormulaR1C1 = "=SUM(R3C:R[-1]C)"
        .Borders.Weight = xlThin
      End With

      .Range("A2").CurrentRegion.EntireColumn.AutoFit
      .Visible = True
    End With
  End If
  rs.Close
End Sub

 

クエリ「Q_PTN_6」

クロス集計したものに対して、全組合せを結び付けたもの

クエリの SQL ビュー
SELECT * FROM
(SELECT T1.営業所, T2.商品 FROM
(SELECT DISTINCT 営業所 FROM TA) AS T1, (SELECT DISTINCT 商品 FROM TA) AS T2
) AS Q1 LEFT JOIN Q_PTN_2 AS Q2 ON (Q1.営業所=Q2.営業所) AND (Q1.商品=Q2.商品)
ORDER BY Q1.営業所, Q1.商品;

Call PtnToExcel("Q_PTN_6") で出力した結果は以下
kEnt170_6


これも整形しておきましょうかということで・・・
無条件で、列C・D を削除しておいて、列A・Bの項目は "." 以降に置換え・・・
後の処理は、PTN_5_4 と同じ
kEnt170_52

Public Sub PTN_6_2()
  Dim rs As New ADODB.Recordset
  Dim i As Long, iRow As Long, iCol As Long
  Dim sS As String

  rs.Open "Q_PTN_6", CurrentProject.Connection, adOpenForwardOnly, adLockReadOnly
  If (Not rs.EOF) Then
    With CreateObject("Excel.Application")
      .WorkBooks.Add
      For i = 0 To rs.Fields.Count - 1
        .Cells(1, i + 1) = rs(i).Name
      Next
      .Cells(2, 1).CopyFromRecordset rs
      .Range("A1").CurrentRegion.Borders.Weight = xlThin
      .Columns("C:D").Delete
      For i = 1 To 2
        sS = .Cells(1, i)
        .Cells(1, i) = Mid(sS, InStr(sS, ".") + 1)
      Next

      .Rows(1).HorizontalAlignment = xlCenter
      .Rows(1).Insert
      iCol = 3
      While (.Cells(2, iCol) <> "")
        sS = .Cells(2, iCol)
        sS = Left(sS, InStr(sS, "_") - 1)
        With .Range(.Cells(1, iCol), .Cells(1, iCol + 2))
          .Merge
          .HorizontalAlignment = xlCenter
          .NumberFormatLocal = "@"
          .Value = sS
          .Borders.Weight = xlThin
        End With
        For i = 0 To 2
          sS = .Cells(2, iCol + i)
          .Cells(2, iCol + i) = Mid(sS, InStr(sS, "_") + 2)
        Next
        iCol = iCol + 3
      Wend

      iRow = .Range("A2").CurrentRegion.SpecialCells(xlCellTypeLastCell).Row
      sS = "C" & iCol - 1
      For i = 0 To 2
        .Cells(2, iCol + i) = "総計:" & .Cells(2, i + 3)
        With .Range(.Cells(3, iCol + i), .Cells(iRow, iCol + i))
          .FormulaR1C1 = "=IF(COUNTA(RC3:R" & sS & ")=0,""""," _
                  & "SUMIF(R2C3:R2" & sS & ",R2C" & i + 3 & ",RC3:R" & sS & "))"
        End With
      Next
      .Range(.Cells(2, iCol), .Cells(iRow, iCol + 2)).Borders.Weight = xlThin
      With .Range(.Cells(iRow + 1, 3), .Cells(iRow + 1, iCol + 2))
        .FormulaR1C1 = "=SUM(R3C:R[-1]C)"
        .Borders.Weight = xlThin
      End With

      .Range("A2").CurrentRegion.EntireColumn.AutoFit
      .Visible = True
    End With
  End If
  rs.Close
End Sub

 


確認用フォーム

kEnt170

フォームを作るまでもなかったのですが、作っておこうか・・・・ ということで

影付き枠部分・・・・これ、オプショングループになってます。
1~4は、見栄えを揃えておこうか・・・・ということで、ここでもオプショングループ・・・
ただ、オプショングループとしては機能してません。
また、枠内にあるのは・・・ コマンドボタン
右側の枠は、オプショングループとして機能しています。
中に配置したのは、トグルボタン・・・・ 連続して同じところは押せなくていいか・・・・

処理として記述したのは以下
Private Sub btn1_Click()
  Call PtnToExcel("Q_PTN_1")
End Sub
Private Sub btn2_Click()
  Call PtnToExcel("Q_PTN_2")
End Sub
Private Sub btn3_Click()
  Call PtnToExcel("Q_PTN_3")
End Sub
Private Sub btn4_Click()
  Call PtnToExcel("Q_PTN_4")
End Sub

Private Sub op1_Click()
  Select Case Me.op1
    Case 1: Call PtnToExcel("Q_PTN_5")
    Case 2: Call PTN_5_2
    Case 3: Call PTN_5_3
    Case 4: Call PTN_5_4
  End Select
End Sub

Private Sub op2_Click()
  Select Case Me.op2
    Case 1: Call PtnToExcel("Q_PTN_6")
    Case 2: Call PTN_6_2
  End Select
End Sub

 

サンプルは以下
 バージョン 20002003 (2002)2007
 ファイル kEnt170_2000.zipkEnt170_2003.zipkEnt170_2007.zip
 サイズ 35,21934,93037,057
※ ファイルは zip 形式
※ 2007 以外は、2007 保存時に変換 & 各バージョンで動作確認 & 最適化

関連記事

2013/09/06

Category: サンプルかな

TB: --  /  CM: 0

top △

この記事に対するコメント

top △

コメントの投稿

Secret

top △


上記広告は1ヶ月以上更新のないブログに表示されています。新しい記事を書くことで広告を消せます。