～ kiku tips ～

SELECT T商品.商品名, T店.店名, Sum(T売上.売上) AS 売上計
FROM (T売上 INNER JOIN T店 ON T売上.店ID=T店.店ID) INNER JOIN T商品 ON T売上.商品ID=T商品.商品ID
WHERE ((Year([売上日])=Year(Date())))
GROUP BY T商品.商品名, T店.店名;

SELECT T商品.商品名, T店.店名, Sum(T売上.売上) AS 売上計
FROM (T売上 INNER JOIN T店 ON T売上.店ID=T店.店ID) INNER JOIN T商品 ON T売上.商品ID=T商品.商品ID
WHERE ((Year([売上日])=Year(Date())-1))
GROUP BY T商品.商品名, T店.店名;

SELECT Q_売上本年.商品名, Q_売上本年.店名, Q_売上本年.売上計/Q_売上前年.売上計 AS 前年比
FROM Q_売上前年 INNER JOIN Q_売上本年 ON (Q_売上前年.商品名=Q_売上本年.商品名) AND (Q_売上前年.店名=Q_売上本年.店名);

SELECT 商品名, Choose(S,'本年実績','前年実績','前年比') AS 実績, 店名, 売上計
FROM (SELECT 1 AS S, * FROM Q_売上本年
UNION ALL
SELECT 2 AS S, * FROM Q_売上前年
UNION ALL
SELECT 3 AS S, * FROM Q_売上前年比) AS Q1
ORDER BY 商品名, 店名, S;

TRANSFORM First(売上計) AS 値
SELECT 商品名, Choose(S,'本年実績','前年実績') AS 実績
FROM (SELECT 1 AS S, * FROM Q_売上本年
UNION ALL
SELECT 2 AS S, * FROM Q_売上前年) AS Q1
GROUP BY 商品名, S
PIVOT 店名;

SELECT Q1.商品名, Choose(S,'本年実績','前年実績','前年比') AS 実績, String(15-len(文字),' ') & 文字 AS 売上計
FROM (
SELECT 1 AS S, 商品名, 店名, Format(売上計,"\\#,##0") AS 文字 FROM Q_売上本年
UNION ALL
SELECT 2 AS S, 商品名, 店名, Format(売上計,"\\#,##0") FROM Q_売上前年
UNION ALL
SELECT 3 AS S, 商品名, 店名, Format(前年比,"0.0%") FROM Q_売上前年比) AS Q1
ORDER BY Q1.商品名, Q1.店名, Q1.S;

TRANSFORM First(String(13-Len(文字)," ") & 文字) AS 値
SELECT 商品名, Choose(S,'本年実績','前年実績','前年比') AS 実績
FROM (
SELECT 1 AS S, 商品名, 店名, Format(売上計,"\\#,##0") AS 文字 FROM Q_売上本年
UNION ALL
SELECT 2 AS S, 商品名, 店名, Format(売上計,"\\#,##0") FROM Q_売上前年
UNION ALL
SELECT 3 AS S, 商品名, 店名, Format(前年比,"0.0%") FROM Q_売上前年比) AS Q1
GROUP BY 商品名, S
PIVOT 店名;

Private Sub btn11_Click()
　　Dim rs As New ADODB.Recordset
　　Dim oApp As Object
　　Dim i As Integer
　　Const CSTART_RANGE As String = "B2" ' Excel 上書き出し位置
　　Const CQNAME As String = "Q_クロス集計"　　 ' クエリ名
　　Const xlCellTypeLastCell = 11

　　rs.Open CQNAME, CurrentProject.Connection, adOpenStatic, adLockReadOnly
　　If (Not rs.EOF) Then
　　　　Set oApp = CreateObject("Excel.Application")
　　　　With oApp
　　　　　　.Workbooks.Add
　　　　　　' レコードセットの転記
　　　　　　With .Range(CSTART_RANGE)
　　　　　　　　For i = 0 To rs.Fields.Count - 1
　　　　　　　　　　.Offset(, i) = rs.Fields(i).Name
　　　　　　　　Next
　　　　　　　　.Offset(1).CopyFromRecordset rs
　　　　　　　　.Offset(.CurrentRegion.Rows.Count + 3).Select
　　　　　　End With
　　　　　　
　　　　　　With .ActiveCell
　　　　　　　　For i = 0 To rs.Fields.Count - 1
　　　　　　　　　　.Offset(, i) = rs.Fields(i).Name
　　　　　　　　Next
　　　　　　　　rs.MoveFirst
　　　　　　　　.Offset(1).CopyFromRecordset rs
　　　　　　　　With oApp.Range(.Offset(1, 2), oApp.Cells.SpecialCells(xlCellTypeLastCell))
　　　　　　　　　　.NumberFormatLocal = "\#,##0;\-#,##0"
　　　　　　　　End With
　　　　　　End With
　　　　　　.Range("A1").Select
　　　　　　.Visible = True
　　　　End With
　　　　Set oApp = Nothing
　　End If
　　rs.Close
End Sub

Private Sub btn12_Click()
　　Dim rs As New ADODB.Recordset
　　Dim oApp As Object
　　Dim i As Integer
　　Const CSTART_RANGE As String = "B2" ' Excel 上書き出し位置
　　Const CQNAME As String = "Q_クロス集計"　　 ' クエリ名
　　Const xlCellTypeLastCell = 11
　　Const xlCenter = -4108
　　Const xlContinuous = 1

　　rs.Open CQNAME, CurrentProject.Connection, adOpenForwardOnly, adLockReadOnly
　　If (Not rs.EOF) Then
　　　　Set oApp = CreateObject("Excel.Application")
　　　　With oApp
　　　　　　.Workbooks.Add
　　　　　　' レコードセットの転記
　　　　　　With .Range(CSTART_RANGE)
　　　　　　　　For i = 2 To rs.Fields.Count - 1
　　　　　　　　　　.Offset(, i) = rs.Fields(i).Name
　　　　　　　　Next
　　　　　　　　.Offset(1).CopyFromRecordset rs
　　　　　　　　With oApp.Range(.Offset(1, 2), oApp.Cells.SpecialCells(xlCellTypeLastCell))
　　　　　　　　　　.NumberFormatLocal = "\#,##0;\-#,##0"
　　　　　　　　End With
　　　　　　　　.Offset(2, 1).Select
　　　　　　End With
　　　　　　' 前年比行の作成
　　　　　　While (.ActiveCell.Value <> "")
　　　　　　　　With .ActiveCell
　　　　　　　　　　.Offset(1).EntireRow.Insert
　　　　　　　　　　.Offset(1, -1) = .Offset(, -1)
　　　　　　　　　　.Offset(1) = "前年比"
　　　　　　　　　　With oApp.Range(.Offset(1, 1), .Offset(1, rs.Fields.Count - 2))
　　　　　　　　　　　　.Font.ColorIndex = 3
　　　　　　　　　　　　.NumberFormatLocal = "0.0%"
　　　　　　　　　　　　.FormulaR1C1 = "=IF(R[-1]C="""","""",R[-2]C/R[-1]C)"
　　　　　　　　　　End With
　　　　　　　　　　.Offset(3).Select
　　　　　　　　End With
　　　　　　Wend
　　　　　　' 見映え
　　　　　　With .Range(CSTART_RANGE)
　　　　　　　　With oApp.Range(.Offset(, 2), .Offset(, rs.Fields.Count - 1))
　　　　　　　　　　.HorizontalAlignment = xlCenter
　　　　　　　　End With
　　　　　　　　With oApp.Range(.Offset(, 1), oApp.Cells.SpecialCells(xlCellTypeLastCell))
　　　　　　　　　　.Borders.LineStyle = xlContinuous
　　　　　　　　　　.EntireColumn.ColumnWidth = 10
　　　　　　　　End With
　　　　　　　　.EntireColumn.AutoFit
　　　　　　End With
　　　　　　.Range("A1").Select
　　　　　　.Visible = True
　　　　End With
　　　　Set oApp = Nothing
　　End If
　　rs.Close
End Sub