FC2ブログ

スポンサーサイト 


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

--/--/--

Category: スポンサー広告

TB： --  /  CM： --

top △

Excel への自力出力例（行・縦計算式挿入） 


回答での事前確認をしていたのですが、回答には使わなくなったので･･･
せっかくだし････
過去の記事にも似通ったものがありましたが、それは置いといて･･･

ユニオンクエリ等を使って、「本年実績」「前年実績」が「商品」別に各店単位で見られるようになっています。
図を見た方が説明は楽という事で･･･
kEnt141

「商品」単位で「前年比」を各店ごとに付加したい。
また、前年比の数値部分を赤色表示したい。

回答したのですが、以下が伝わっていれば良いのですが
・１つのフィールドに複数の書式（今回は、通貨とパーセント）は設定できなかったかと
・UNION する時に、値をそれ用のものに文字列として変換、右詰になるように固定長に（左に空白埋めて）
・部分的に文字の色を変更するのはできなかったかと･･･（クエリでの事･･･）

よって、いっそのこと出力先をExcel にして、出来上がった部分を CopyFromRecordset で転記後、
前年比行を追加して、計算式を埋め込めば････

今回のサンプルは、
この前年比行を追加して、計算式を埋め込む、文字色を赤に、＋罫線
の例になるかと思います。

文字の色変えは、フォームを使えば条件付き書式で可能ですが･････クエリで･･･ということで
（出力先を Excel へ････っていうのも、突拍子もない事ですけど････）
 
基本となるテーブル、クエリを作っていきます。
kEnt141_1　　kEnt141_2　　kEnt141_3

テーブルは、「T商品」「T店」と「T売上」の３つ

「T商品」のフィールドは、「商品ID」「商品名」の２つ
「T店」のフィールドは、「店ID」「店名」の２つ
「T売上」のフィールドは、「an」（オートナンバ）と
　「売上日」「商品ID」「店ID」「売上」「更新日時」「備考」の７つ
　「商品ID」「店ID」部分は、他のテーブルをルックアップし、「名」の方を表示するように

サンプルデータとして、2010/2011/2012 年のデータを「商品」「店」ごとに２件
クエリとして、
「Q_売上本年」「Q_売上前年」「Q_売上前年比」「Q_単なるUNION」「Q_クロス集計」の５つと
「Q_単なるUNION改」「Q_クロス集計改」の２つ
後者の２つは、表示する「売上計」「前年比」部分を文字列に変換したもの･･･
（１つのフィールド内で書式を複数使いたいための苦肉の策）

表示を確認していきますが、久しぶりに用意したメニュー用フォーム「F_MENU」を起動します。
（「･･･改」となっているクエリは直接確認します）

クエリとして記述した内容は、次の通りです。

「Q_売上本年」
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店.店名;

 

「Q_売上前年」
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店.店名;

 

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

 

「Q_単なるUNION」
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;

 
ここで悩んだんですが、「本年実績」「前年実績」「前年比」をどの段階で入れ込もうか･･･

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

並び替えする前に上記の様に入れてしまうと、
「商品名」「店名」で並んだあと「前年実績」「前年比」「本年実績」の順になってしまうので
並び替えは数字で行って、その数字に対応するように文字列に置換え････としました。
以降の記述も同様です。

「Q_クロス集計」
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 店名;

 

「Q_単なるUNION改」
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;

 

「Q_クロス集計改」
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 店名;

 

なお、上記テーブル、クエリを表示した後、フォーム内「テーブル・クエリの表示確認」を
クリックすると、表示は消えます。
（エラー処理は入れていないので、見映え等変更していた場合は「キャンセル」は選ばないで･･･）


ここからが、一応メインの Excel への出力になります。

「単なる出力＋α」をクリックすると、以下の様な感じで Excel が表示されると思います。
kEnt141_4
クエリ「Q_クロス集計」を使用し、単に CopyFromRecordset で出力したもの（図の上側）
単に CopyFromRecordset で出力しただけでは数値部分が通貨表示にならないので書式を設定

VBA 記述したのは以下
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

 
ここで、再認識したのですが、CopyFromRecordset 後の rs は、EOF = True になっており、
再利用する時には rs.MoveFirst が必要ですが、adOpenForwardOnly　指定では、
2007 では動くようですが、2000 / 2003 ではエラーになりますね･･･
なので、adOpenStatic を指定していました。

上記に「前年比」を追加し、文字の色変え、書式設定、「比」の計算式盛り込み、＋罫線
＋見映えをチョコっと
kEnt141_5
この記述が以下
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

 
まず、CopyFromRecordset した後に、数値部分を通貨表示に書式を設定します。
その後、「前年実績」に移動し、そこに文字が埋まっていたら、下に行を追加し、
商品名、前年比文字を埋めます。
追加した行の数値部分にあたるところに、文字色、パーセントの書式、計算式を埋め込みます。
次の「前年実績」があるはずところに移動し、処理を繰り返します。
後は見映え用に、店名部分を中央配置に、罫線引いて、セル幅揃えて････
で最後に、「A1」を選んで、Excel を表示するように････

サンプルは以下
 バージョン 20002003 (2002)2007
 ファイル kEnt141_2000.zipkEnt141_2003.zipkEnt141_2007.zip
 サイズ 27,82828,51930,719
※ ファイルは zip 形式
※ 2007 以外は、2007 保存時に変換 & 各バージョンで動作確認 & 最適化

関連記事

2012/10/09

Category: サンプルかな

TB： --  /  CM： 0

top △

« Excel VBA をやってみた その５
Excel VBA をやってみた その４ »

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

top △

コメントの投稿

Secret

top △

| h o m e |


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