基本的な考え方
- DBから、データを取得する時に、できる計算処理はなるべくSQLで行う。
- VBAでは、できる限り分析用に成形する処理を行う。
- DBからデータを取得、シートに出力、テーブル化、成形処理を実施。
ListObjectsについて（本題）
- ListObjectsをできる限り利用するようにしたいと考えている。
- 理由としては、最終行などの取得などの処理がないこと。
- 多分、関数を使う時よりも、速い気がする。
- どちらかというと、多少の処理速度よりもソースの見やすさや改修のしやすさを重視したいので、たぶん、ListObjectsの方がシンプルなソースになると思う。
Sub CalcKyakutanka()
If Sheet1.ListObjects.Count > 0 Then
Sheet1.ListObjects(1).Unlist
End If
'Sheet1.Cells.Clear
Stop
With Sheet1
.Range("A1").Select
With .ListObjects.Add
' テーブル名・・・省略可能
' .Name = "tbl_Kyakutanka"
' 行からセルを特定・・・2行目の4列目
' .ListRows(1).Range.Item(4).Formula = "=[@売上]/[@客数]"
' 列からセルを特定・・・4列目の2行目
' .ListColumns(4).Range(2).Formula = "=INT([@売上]/[@客数])" '・・・整数
.ListColumns(4).Range(2).Formula = "=ROUND([@売上]/[@客数],2)" '・・・小数点第2で、丸目
' 列（列名）から、セルを特定・・・客単価列の2行目
' .ListColumns("客単価").Range(2).Formula = "=[@売上]/[@客数]"
' 小数点を設定・・・注意：四捨五入で繰り上げされます
'.ListColumns(4).Range.NumberFormatLocal = "##.##"
Dim arr_ans_uriage As Variant: arr_ans_uriage = .ListColumns(2).DataBodyRange
Dim arr_ans_kyakusu As Variant: arr_ans_kyakusu = .ListColumns(3).DataBodyRange
Dim arr_ans_kyakutanka As Variant: arr_ans_kyakutanka = .ListColumns(4).DataBodyRange
End With
End With
With Sheet1.ListObjects(1)
Call MakeChart(Sheet1, arr_ans_uriage, 34500, .ListColumns(2).Range(1).Value, Range("F2"), Range("K2"))
Call MakeChart(Sheet1, arr_ans_kyakusu, 50, .ListColumns(3).Range(1).Value, Range("F14"), Range("K14"))
Call MakeChart(Sheet1, arr_ans_kyakutanka, 1000, .ListColumns(4).Range(1).Value, Range("F26"), Range("K26"))
' Call MakeChart(Sheet1, arr_ans_kyakutanka, arr_ans_uriage, 50, .ListColumns(4).Range(1).Value, Range("F2"), Range("K2"))
End With
End Sub
' グラフを生成
'Sub MakeChart(ByVal sh As Worksheet, ByVal arr_header As Variant, ByVal arr_val As Variant, ByVal line_val As Long)
Sub MakeChart(ByVal sh As Worksheet, ByVal arr_val As Variant, ByVal line_val As Long, ByVal chartNames As String, ByVal lRng As Range, ByVal tRnge As Range)
'Sub MakeChart(ByVal sh As Worksheet, ByVal arr_val As Variant, ByVal arr_val_line As Variant, ByVal line_val As Long, ByVal chartNames As String, ByVal lRng As Range, ByVal tRnge As Range)
sh.Select
Dim co As ChartObject
' グラフの外枠？を設置
Set co = ActiveSheet.ChartObjects.Add(Left:=lRng.Left, Top:=tRnge.Top, Width:=300, Height:=200)
' グラフの中身を生成
With co
With .Chart.SeriesCollection.NewSeries
.Name = chartNames
.Values = arr_val
'.XValues = arr_header
End With
End With
With co.Chart
' グラフのスタイルを設定
.ChartStyle = 209
'グラフ形式を設定
co.Chart.ChartType = xlColumnClustered
'凡例非表示
co.Chart.HasLegend = True
' ' グラフの左線を強調（線の太さと色・・・結構見やすいかも）
' .Axes(xlValue).Format.Line.Weight = 2
' .Axes(xlValue).Format.Line.ForeColor.RGB = RGB(0, 0, 0)
'
' ' グラフの下線を強調
' .Axes(xlCategory).Format.Line.Weight = 2
' .Axes(xlCategory).Format.Line.ForeColor.RGB = RGB(0, 0, 0)
' '折れ線グラフを追加
' With .SeriesCollection.NewSeries
' .Name = "客数"
' .Values = arr_val_line
' .ChartType = xlLineMarkers '折れ線
' .AxisGroup = 2 '第2軸
' .Format.Line.ForeColor.RGB = RGB(255, 192, 0)
' End With
'基準線を新規系列として追加
With .SeriesCollection.NewSeries
.Name = "閾値" '特に必要はない
.Values = "={" & Join(Array(line_val, line_val), ",") & "}"
.ChartType = xlLine '折れ線
.AxisGroup = 2 '第2軸
.Format.Line.ForeColor.RGB = RGB(255, 192, 0)
End With
'第2縦軸のScaleを第1縦軸に合わせる
.Axes(xlValue, 2).MinimumScale = .Axes(xlValue, 1).MinimumScale
.Axes(xlValue, 2).MaximumScale = .Axes(xlValue, 1).MaximumScale
.Axes(xlValue, 2).Delete '第2軸を消す
'グラフ内左右余白を消す：基準線を第2横軸に設定
.HasAxis(xlCategory, 2) = True '第2横軸表示
.Axes(xlCategory, 2).AxisBetweenCategories = False '軸位置を目盛
.Axes(xlCategory, 2).TickLabelPosition = xlNone '目盛ラベルなし
End With
End Sub
