Michael Stowe
Microsoft Corporation
May 2002
日本語版最終更新日 2002 年 6 月 13 日
対象:
Microsoft® Excel 2002
Microsoft SQL Server 2000 Analysis Services
概要: 集計値の詳細レコードを取得するために、新しい集計を持つように OLAP キューブを更新するために、さらにピボットテーブルを作成しないで OLAP キューブからワークシートに 1 つ以上の集計を取得するために、Excel OLAP 機能を拡張する方法について説明します。
odc_xlextendolap.exe は、
MSDN Code Center からダウンロードしてください。
目次
はじめに
詳細へのドリル スルー
ピボットテーブルのデータによる "what if" 分析の実行
OLAP がバインドされない !
まとめ
はじめに
Microsoft® Excel は、OLAP (オンライン分析処理) キューブに格納されたデータをまとめるために、
Microsoft PivotTables® を使用する機能を提供します。
この資料では、
集計値の詳細レコードを取得するために、
新しい集計を持つように OLAP キューブを更新するために、
さらにピボットテーブルを作成しないで OLAP キューブからワークシートに 1 つ以上の集計を取得するために、
Excel OLAP 機能を拡張する方法について説明します。
必要なシステム
この資料で説明する例では、以下のソフトウェアが 1 台のコンピュータにインストールされている必要があります。
- Microsoft Excel 2002。
- FoodMart 2000 サンプル データベースを含む Microsoft SQL Server™ Analysis Services。
各例では、ローカルホストを分析サーバーとして指定します。
- この資料の先頭の odc_xlextendolap.exe のダウンロードに含まれている Extending OLAP.xls スプレッドシート。
- 「詳細へのドリル スルー」の例では、
FoodMart 2000 データベースの Sales キューブでドリル スルーを有効にする必要があります。
ドリルスルーを有効にするには、
分析サーバーで提供される SQL Server Books Online のトピック「ドリル スルー オプションの指定」を参照してください。
- 「ピボットテーブルのデータによる "what if" 分析の実行」の例では、
FoodMart 2000 データベースの Warehouse キューブで書き戻しを有効にする必要があります。
書き戻しを有効にするには、
分析サーバーで提供される SQL Server Books Online のトピック「書き込み可能なキューブ」を参照してください。
- 「OLAP がバインドされない」の例では、OLAP CubeCellValue アドインが必要です。
このアドインの詳細については、
「Excel 2002 Add-in: OLAP CubeCellValue」
(英語) を参照してください。
詳細へのドリル スルー
データ ウェアハウスを構成する OLAP キューブには、
大量のマルチ ディメンション データの集計が含まれています。
ピボットテーブルに表示される集計値を提供している詳細レコードを表示したい場合があります。
Microsoft SQL Server 2000 Analysis Services では、ドリル スルーと呼ばれる機能を導入しました。
これは、元になる詳細レコードを示すために、
集計への "ドリル スルー" を可能にします。
Excel 2002 のオブジェクト モデルは、ドリル スルー操作を実行するためのネイティブなサポートを提供していません。
次の例では、Microsoft ActiveX® Data Objects Multidimensional (ADOMD) タイプ ライブラリを使用して、
ドリル スルー操作を実行する方法について説明しています。
この例では、
OLAP Drillthough というメニュー コマンドをピボットテーブルのショートカット メニューに追加します。
OLAP ピボットテーブルのデータ領域でユーザーがこのメニュー項目を選択すると、
適切なドリル スルーのクエリが Analysis Services に送られ、
詳細レコードが新しいワークシートに書き込まれます。
これを試すには、Extending OLAP.xls サンプル ブックの Drillthrough ワークシート上のデータ セルを右クリックして、
[OLAP Drillthrough] をクリックします。
メニュー項目は、Workbook_Open イベントで作成されます。
Private Sub Workbook_Open()
Dim ptcon As CommandBar
Dim cmdDrill As CommandBarControl
Set ptcon = Application.CommandBars("PivotTable context menu")
For Each btn In ptcon.Controls
' メニュー項目が既に存在する場合は、プロシージャを終了します。
If btn.Caption = "OLAP Drillthrough" Then GoTo noadd
Next btn
' 項目をピボットテーブルのショートカット メニューに追加します。
Set cmdDrill = ptcon.Controls.Add( _
Type:=msoControlButton, temporary:=True)
' メニュー項目のプロパティを設定します。
cmdDrill.Caption = "OLAP Drillthrough"
cmdDrill.OnAction = "Drillthrough"
noadd:
End Sub
[OLAP Drillthrough] をクリックして、Drillthrough プロシージャを呼び出します。
Sub Drillthrough()
Dim Cat As ADOMD.Catalog
Dim Conn As ADODB.Connection
Dim qry As String
Dim pcell As PivotCell
Dim pt As PivotTable
Dim i As Integer
Dim rs As ADODB.Recordset
Dim iAxisNum As Integer
Dim sDrillQry As String
' アクティブ セルの PivotCell オブジェクトを変数に設定します。
Set pcell = ActiveCell.PivotCell
' そのセルが OLAP ピボットテーブルの一部ではない場合、
' errmsg エラー ハンドラを呼び出します。
If Not (pcell.PivotTable.PivotCache.OLAP) Then GoTo errmsg
' そのセルがピボットテーブルのデータ領域にない場合、
' errmsg エラー ハンドラを呼び出します。
If pcell.PivotCellType <> xlPivotCellValue Then GoTo errmsg
Set pt = pcell.PivotTable
' ピボットテーブルのキャッシュが
' データ ソースに接続されていることを確認します。
If Not pt.PivotCache.IsConnected Then
pt.PivotCache.MakeConnection
End If
Drillthrough プロシージャの最初の部分では、
プロシージャで使用する変数を割り当て、
基本的なエラー チェックを実行します。
最初に、ピボットテーブル レポートでアクティブ セルを表す PivotCell オブジェクトを変数に設定します。
次に、2 つの If ステートメントを使用して、
ピボットテーブル レポートが OLAP データ ソースに接続されているかどうか、
およびアクティブ セルがピボットテーブル レポートのデータ領域にあるかどうかを判断します。
これらのステートメントのいずれかが False の場合、
errmsg という名前のエラー ハンドラが呼び出されます。
最後に、ピボットテーブル レポートのキャッシュをデータ ソースに接続します。
' 新しいカタログを作成します。
Set Cat = New ADOMD.Catalog
' 新しい接続を作成します。
Set Conn = New ADODB.Connection
' ADOMD カタログをセットアップします。
Set Cat.ActiveConnection = pt.PivotCache.ADOConnection
' ADO 接続をセットアップします。
Set Conn = pt.PivotCache.ADOConnection
このセクションでは、ADO の Connection オブジェクトと ADOMD の Catalog オブジェクトを作成して、
両方のオブジェクトをピボットテーブル レポートのキャッシュ (PivotCache) に接続します。
sDrillQry = "Drillthrough maxrows 2500 Select "
"sDrillQry" 変数を使用して、詳細レコードの取得に使用する MDX (マルチ ディメンション式) クエリを格納します。
これは、このプロシージャの後半で付加される文字列の一番左の部分です。
' 行項目をループします。
' 最も外側の項目が MDX ステートメントに追加されます。
For i = 1 To pcell.RowItems.Count 1
If pcell.RowItems(i).Parent.CubeField.Name <> _
pcell.RowItems(i + 1).Parent.CubeField.Name Then
' その項目を MDX ステートメントに付加します。
sDrillQry = sDrillQry & "{" & pcell.RowItems(i) & _
"} on " & iAxisNum & ", "
' 軸ディメンションを増加します。
iAxisNum = iAxisNum + 1
End If
Next i
' 1 つ以上の項目が行軸に追加された場合、
' 最も内側の行項目を追加します。
If pcell.RowItems.Count > 0 Then
' その項目を MDX ステートメントに付加します。
sDrillQry = sDrillQry & "{" & pcell.RowItems(i) & _
"} on " & iAxisNum & ", "
' 軸ディメンションを増加します。
iAxisNum = iAxisNum + 1
End If
プロシージャのこのセクションでは、
MDX クエリのピボットテーブル レポートの行軸に表示されるフィールドを表す部分を構築します。
' 行項目をループします。
' 最も外側の項目を MDX ステートメントに付加します。
For i = 1 To pcell.ColumnItems.Count - 1
If pcell.ColumnItems(i).Parent.CubeField.Name <> _
pcell.ColumnItems(i + 1).Parent.CubeField.Name Then
' その項目を MDX ステートメントに付加します。
sDrillQry = sDrillQry & "{" & pcell.RowItems(i) & _
"} on " & iAxisNum & ", "
' 軸ディメンションを増加します。
iAxisNum = iAxisNum + 1
End If
Next i
' 1 つ以上の項目が列軸に追加されている場合、
' 最も内側の列項目を付加します。
If pcell.ColumnItems.Count > 0 Then
' その項目を MDX ステートメントに付加します。
sDrillQry = sDrillQry & "{" & pcell.ColumnItems(i) _
& "} on " & iAxisNum & ", "
' 軸ディメンションを増加します。
iAxisNum = iAxisNum + 1
End If
プロシージャのこのセクションでは、
MDX クエリのピボットテーブル レポートの列軸に表示されるフィールドを表す部分を構築します。
' 表示可能なページ項目をループします。
For i = 1 To pt.PageFields.Count
' その項目を MDX ステートメントに付加します。
sDrillQry = sDrillQry & "{" & pt.PageFields(i).CurrentPageName
_
& "} on " & iAxisNum & ", "
' 軸ディメンションを増加します。
iAxisNum = iAxisNum + 1
Next I
プロシージャのこのセクションでは、
MDX クエリのピボットテーブル レポートのページ軸に表示されるフィールドを表す部分を構築します。
' 末尾の ", " を削除します。
sDrillQry = Left$(sDrillQry, Len(sDrillQry) - 2)
' キューブ名を MDX ステートメントに追加します。
sDrillQry = sDrillQry & " From " & "[" & _
pt.PivotCache.CommandText & "]"
' 新しいレコードセットを作成します。
Set rs = New ADODB.Recordset
On Error GoTo errmsg
With rs
' MDX ステートメントをレコードセット オブジェクトに渡します。
.Source = sDrillQry
Set .ActiveConnection = Conn
' レコードセットを開きます。
.Open
End With
このセクションでは、MDX ステートメントを完成し、
新しい ADO の Recordset オブジェクトのソース データとして指定します。
On Error GoTo 0
' 新しいワークシートを追加します。
Set ws = Worksheets.Add
' クエリ テーブルをワークシートに追加します。
' MDX ステートメントの結果を保持するレコードセットにクエリ テーブルを接続します。
With ws.QueryTables.Add(Connection:=rs,
Destination:=ws.Range("A1"))
.Refresh
End With
Exit Sub
errmsg:
MsgBox "Cannot Drillthrough on this selection."
End Sub
このプロシージャの最後のセクションでは、
新しいワークシートをブックに追加します。
その後、QueryTable オブジェクト経由で MDX ステートメントの結果がそのワークシートに返されます。
ピボットテーブルのデータによる "what if" 分析の実行
これまでに、ピボットテーブルを使用して "what-if" 分析を実行したいと考えたことはありましたか?
SQL Server Analysis Services には、書き戻しと呼ばれる機能があります。
これは、クライアント アプリケーションが OLAP キューブのデータに対する変更を記録できるようにします。
Excel 2002 は、書き戻し操作を実行するためのネイティブなサポートを提供しません。
次の例では、Excel イベントを使用して、
ピボットテーブルに行われた変更をキャプチャし、
処理中に適切な MDX ステートメントを構築して Analysis Services に送る方法について説明しています。
これを試すには、
Extending OLAP.xls サンプル ブックの Writeback ワークシート上の空のデータ セルに値を入力して、
Enter キーを押します。
ピボットテーブルへの変更は、
ピボットテーブルを保持するワークシートの Worksheet_Change イベントによってキャプチャされます。
Private Sub Worksheet_Change(ByVal Target As Range)
Dim cell As PivotCell
' このイベントがワークシートから呼び出されると、Err.Number は 0 を返します。
' Writeback プロシージャで Undo が呼び出されると、
' 別の値を返します。
If Err.Number <> 0 Then GoTo done
' このイベントは、Writeback プロシージャによって再度呼び出されます。
' これは、他に問題がなければその呼び出しを終了します。
If TypeName(Target.Value) <> "Double" Then GoTo done
On Error GoTo done
' PivotCell オブジェクトを設定します。ピボットテーブルに変更がない場合、
' done エラー ハンドラが呼び出されます。
Set cell = Target.PivotCell
On Error GoTo 0
' ピボットテーブルのセルの変更がデータ領域に存在する場合、
' その変更を書き戻し操作として処理します。
If cell.PivotCellType = xlPivotCellValue Then
Call Writeback(cell, Target.Value)
End If
done:
On Error GoTo 0
End Sub
このプロシージャでは、
ピボットテーブルのデータ領域の値が変更されたことを確認します。
変更されていると、
Writeback プロシージャが呼び出されます。
変更された集計を表す PivotCell オブジェクトと新しい集計値が Writeback プロシージャに渡されます。
Sub Writeback(pcell As PivotCell, newval As Double)
Dim adoCmd As ADODB.Command
Dim Conn As ADODB.Connection
Dim pt As PivotTable
Dim pcache As PivotCache
Dim pf As PivotField
Dim pitmlist(1 to 2) As PivotItemList
Dim cmdtxt As String
Dim itmtxt As String
Dim oldcf As String
Dim cubnam As String
Dim i As Integer
Dim k As Integer
' 処理時間の大部分が Excel 以外で行われるので、
' 更新の状態を表示することをお勧めします。
Application.Cursor = xlWait
' ピボットテーブルとピボットテーブルのキャッシュを表す変数をセットアップします。
Set pt = pcell.Parent
Set pcache = pt.PivotCache
' ピボットテーブルのキャッシュがデータ ソースに
' 接続されていることを確認します。
If Not pcache.IsConnected Then
pcache.MakeConnection
End If
' 新しい ADO Command オブジェクトを作成します。
Set adoCmd = New ADODB.Command
' 新しい ADO のレコードセットを作成します。
Set Conn = New ADODB.Connection
' セッション コマンド オブジェクトを設定後、
' 接続オブジェクトへのハンドルを取得します。
Set adoCmd.ActiveConnection = pcache.ADOConnection
Set Conn = adoCmd.ActiveConnection
Writeback プロシージャの最初の部分では、
変更された集計を Analysis Services に送信するのに必要な接続を作成するプロシージャで使用する変数を割り当てます。
プロシージャに渡された PivotCell オブジェクトは、
必要な PivotTable オブジェクト、PivotCache オブジェクト、
ADO Command オブジェクトおよび ADO Connection オブジェクトをセットアップするためのキーです。
' cmdtxt 変数は、Analysis Services に送信するコマンドを格納して、
' 割り当てを実行します。
cmdtxt = ""
cmdtxt = cmdtxt & pcell.DataField.Name & ","
' 各ページ フィールドを cmdtxt 変数に追加します。
If pt.PageFields.Count > 0 Then
For Each pf In pt.PageFields
cmdtxt = cmdtxt & pf.CurrentPageName & ","
Next pf
End If
このセクションの最初の 2 行のコードは、
Analysis Services に送信する MDX ステートメントを格納する String 変数 (cmdtxt) を初期化します。
For. . .Each ループでは、
すべてのページ フィールドを "cmdtxt" 変数に追加します。
Set pitmlist(1) = pcell.RowItems
Set pitmlist(2) = pcell.ColumnItems
For k = 1 To 2
' ビューに行フィールドがあれば、その行フィールドを cmdtxt に追加します。
If pitmlist(k).Count > 0 Then
' itmtxt 変数は、一時テキストを保持します。
' ビュー内の各ディメンションの最下位レベルだけを cmdtxt に追加します。
itmtxt = ""
oldcf = pitmlist(k)(1).Parent.CubeField.Name
' CubeField を変更すると、このループだけが cmdtxt に追加します。
For i = 1 To pitmlist(k).Count
If pitmlist(k)(i).Parent.CubeField.Name = oldcf Then
itmtxt = pitmlist(k)(i)
Else
cmdtxt = cmdtxt & itmtxt & ","
oldcf = pitmlist(k)(i).Parent.CubeField.Name
itmtxt = pitmlist(k)(i)
End If
Next i
' 最後の行項目は常に最下位レベルなので、cmdtxt に追加されます。
itmtxt = pitmlist(k)(pitmlist(k).Count)
cmdtxt = cmdtxt & itmtxt & ","
End If
Next k
このセクションでは、適切な行項目と列項目を "cmdtxt" 変数に追加します。
"pitmlist" 変数は、PivotItem オブジェクトの配列です。
配列の最初の項目ムは、
RowItem オブジェクトのコレクションです。
配列の 2 番目の項目は、ColumnItem オブジェクトのコレクションです。
cubnam = "[" & pcache.CommandText & "]"
' 最終的なコマンドを作成して、分析サーバーに送信します。
' データを提供しているセルごとに新しい集計を均等に分割します。
cmdtxt = "Update cube " & cubnam & " set (" & _
Left(cmdtxt, Len(cmdtxt) - 1) & ")=" & _
newval & " Use_Equal_allocation"
' MDX ステートメントを Command オブジェクトに渡して、
' 更新を実行します。
With adoCmd
.CommandText = cmdtxt
.Execute
End With
On Error GoTo writefailed
' 新しい Transaction オブジェクトを開いて、
' 変更をコミットします。
With Conn
.Attributes = adXactCommitRetaining
.CommitTrans
End With
' ピボットテーブルを最新状態に更新して、
' 割り当て結果をビューに表示します。
pcache.Refresh
GoTo cleanup
このセクションのコードは、最終的な MDX ステートメントを組み立て、
ADO Command オブジェクト経由で、
更新された集計を分析サーバーに送信します。
最後に、更新をコミットして、ピボットテーブルを最新状態に更新して、
小計を更新します。
writefailed:
Select Case Err.Number
' タイムアウト エラーの警告。
Case -2147168234
MsgBox "Writeback failed due to a timeout."
' 読み取り専用エラーの警告。
Case -2147168254
MsgBox "Writeback failed because the OLAP cube " & _
"is not write-enabled."
Case Else
' その他のエラーの警告。
MsgBox "Cannot commit the updated value to Analysis
Server."
End Select
' 編集を元に戻します。
Application.Undo
GoTo cleanup
' ADO 変数のクリーンアップとマウス カーソルのクリーンアップ。
Set Cmd = Nothing
Set Conn = Nothing
Application.Cursor = xlDefault
End Sub
最後のセクションのコードは、
エラー メッセージを表示するエラー ハンドラを保持し、
Undo メソッドを使用して、変更されたセルの値をロールバックします。
OLAP がバインドされない!
ピボットテーブルを使用して、Excel で OLAP キューブに格納されたデータを分析する必要があります。
Excel 2002 のリリース後、OLAP の CubeCellValue アドインが Web サイトの Microsoft Office ツールに提供されるまで、
ここまでの内容は正しい説明でした。
OLAP の CubeCellValue アドインによって、
OLAP キューブから直接セルに 1 つの集計値を取得できます。
アドインは、OLAP キューブから集計値を取得するために CubeCellValue 関数を使用します。
ダイアログ ボックスを使用して、関数のパラメータを指定するか、
または関数を直接セルに入力できます。
次の例では、メンバ名を直接ワークシートに入力することによって、
OLAP キューブから集計値を取得する 1 つのアプローチについて説明しています。
これを試すには、
Extending OLAP.xls サンプル ブックの Free Range OLAP ワークシートのセル C5 に「Food」と入力して、
セル D4 に「Q1」を入力し、Enter キーを押します。
この例では、
メンバ名を受け取る 2 つの "hot" ゾーンを使用します。
ユーザーがワークシート上で値を変更すると、
Worksheet_Change イベントを使用して、
その変更が hot 領域のいずれか 1 つで行われたかどうか判断します。
ユーザーが hot 領域のいずれかに値を入力した場合、
FreeRangeOLAP プロシージャが呼び出されます。
このプロシージャは、hot 領域を分析して、
適切な CubeCellValue 式を構築します。
この例を使用するときは、
OLAP の CubeCellValue アドインによって、
複数のメンバを同じディメンションから指定できないことに注意してください。
Private Sub Worksheet_Change(ByVal Target As Range)
Dim rngHotRows As Range
Dim rngHotCols As Range
Dim rngData As Range
Dim rngRowTest As Range
Dim rngColTest As Range
' セルが消去されている場合、プロシージャを終了します。
If IsEmpty(Target.Value) Then GoTo done
' 変更された領域が複数のセルで構成されている場合、プロシージャを終了します。
If IsArray(Target.Value) Then GoTo done
' CubeCellValue 式を記述する結果として呼び出されると、
' プロシージャを終了します。
If Left(Target.Formula, 14) = "=CubeCellValue" Then GoTo done
Worksheet_Change プロシージャの最初のセクションでは、
いくつかの変数を宣言して、変更されたセル領域に関していくつか問い合わせを行っています。
' 入力領域、および式の範囲の左上隅のセルを示す
' 変数を設定します。
Set rngHotRows = Range("B5:C10")
Set rngHotCols = Range("D3:H4")
Set rngData = Range("D5")
' 変更されたセルと hot セル範囲の積集合 (交差部分) に
' 変数を設定します。
Set rngRowTest = Application.Intersect(Target, rngHotRows)
Set rngColTest = Application.Intersect(Target, rngHotCols)
' 変更されたセルが hot セル範囲のいずれかにあるかどうかを確認します。
' 範囲内に存在する場合、FreeRangeOLAP プロシージャを呼び出します。
If (Not rngRowTest Is Nothing) Or (Not rngColTest Is Nothing) Then
Call FreeRangeOLAP(rngHotRows, rngHotCols, rngData)
End If
done:
End Sub
このコードは、hot セル範囲を確立して、その範囲内に変更されたセルが含まれているかどうか確認します。
変更されたセルが hot セル範囲内の場合、FreeRangeOLAP プロシージャを呼び出します。
Sub FreeRangeOLAP(ByVal rngHotRows, ByVal rngHotCols, ByVal rngData)
Dim cell As Range
Dim sCubeFormula As String
Dim i As Integer
' "hot" 行をループします。
For Each cell In rngHotRows
' セルの値を確認します。
If cell.Value <> "" Then
i = 1
' 式の文字列を初期化します。
sCubeFormula = "=CubeCellValue" & _
"(""localhost FoodMart 2000 Sales"","
' 現在のセルの値を式に追加します。
sCubeFormula = sCubeFormula & Chr$(34) & _
BracketIt(cell.Value) & Chr$(34) & ","
' 列 B と列 C の両方が値を保持している場合、式に追加します。
If cell.Column = 2 And cell.Offset(0, 1).Value <> "" Then
sCubeFormula = sCubeFormula & Chr$(34) & _
BracketIt(cell.Offset(0, 1) _
.Value) & Chr$(34) & ","
End If
' 列 B と列 C の両方が値を保持している場合、式に追加します。
If cell.Column = 3 And cell.Offset(0, -1).Value <> "" Then
sCubeFormula = sCubeFormula & Chr$(34) & _
BracketIt(cell.Offset(0, -1) _
.Value) & Chr$(34) & ","
End If
' 列範囲の先頭行に値が入力されている場合、
' 式に追加します。
If Range("a1").Cells(3, rngData.Offset(cell.Row - 5, i - 1)
_
.Column).Value <> "" Then
sCubeFormula = sCubeFormula & Chr$(34) & _
BracketIt(Range("a1").Cells(3, _
rngData.Offset(cell.Row - 5, _
i - 1).Column).Value) & Chr$(34) & ","
End If
' 列範囲の 2 行目に値が入力されている場合、
' 式に追加します。
If Range("a1").Cells(4, rngData.Offset(cell.Row - 5, i - 1)
_
.Column).Value <> "" Then
sCubeFormula = sCubeFormula & Chr$(34) & _
BracketIt(Range("a1").Cells(4, _
rngData.Offset(cell.Row - 5, _
i - 1).Column).Value) & Chr$(34) & ","
End If
' CubeCellValue 式に右かっこを追加します。
sCubeFormula = Left(sCubeFormula, Len(sCubeFormula) - 1) &
")"
' CubeCellValue 式をワークシートに書き込みます。
rngData.Offset(cell.Row - 5, i - 1).FormulaR1C1 =
sCubeFormula
FreeRangeOLAP プロシージャのこのセクションでは、
hot 行範囲 (B5:C10) の各セルをループすることから処理を始めます。
値を検出すると、
最終的に CubeCellValue 式 (sCubeFormula) を表す変数を初期化します。
セル値を sCubeFormula 文字列に連結します。
コードは、hot 行範囲のセル (B5:C10) と最初の hot 列 (D3:D4) のセルのさまざまな組み合わせを確認します。
適切な値が sCubeFormula 文字列に追加されます。
BracketIt 関数は、
新しい値が sCubeFormula 文字列に追加されるたびに呼び出されます。
この関数は、単にセルの値に右かっこを追加します。
最終的に、CubeCellValue 式が適切なセルに書き込まれます。
' 最後の 4 つの "hot" 列をループします。
For i = 2 To rngHotCols.Columns.Count
' 列の入力領域内の "hot" セルのいずれかの行が値を保持する場合、
' 式に追加します。
If rngHotCols.Cells(1, 1).Offset(0, i - 1).Value <> ""
Or _
rngHotCols.Cells(1, 1).Offset(1, i - 1).Value
<> "" Then
' 式の文字列を再初期化します。
sCubeFormula = "=CubeCellValue" & _
"(""localhost FoodMart 2000 Sales"","
sCubeFormula = sCubeFormula & Chr$(34) & _
BracketIt(cell.Value) & Chr$(34) & ","
' 列 B と列 C の両方が値を保持している場合、
' 式に追加します。
If cell.Column = 2 And _
cell.Offset(0, 1).Value <> "" Then
sCubeFormula = sCubeFormula & Chr$(34) & _
BracketIt(cell.Offset(0, 1) _
.Value) & Chr$(34) & ","
End If
' 列 B と列 C の両方が値を保持している場合、
' 式に追加します。
If cell.Column = 3 And _
cell.Offset(0, -1).Value <> "" Then
sCubeFormula = sCubeFormula & Chr$(34) & _
BracketIt(cell.Offset(0, -1) _
.Value) & Chr$(34) & ","
End If
' 列範囲の先頭行に値が入力されている場合、
' 式に追加します。
If Range("a1").Cells(3, rngData.Offset(cell.Row
5, _
i - 1).Column).Value <> "" Then
sCubeFormula = sCubeFormula & Chr$(34) & _
BracketIt(Range("a1").Cells(3, _
rngData.Offset(cell.Row - 5, _
i - 1).Column).Value) & _
Chr$(34) & ","
End If
' 列範囲の 2 行目に値が入力されている場合、
' 式に追加します。
If Range("a1").Cells(4, rngData.Offset(cell.Row
5, _
i - 1).Column).Value <> "" Then
sCubeFormula = sCubeFormula & Chr$(34) & _
BracketIt(Range("a1").Cells(4, _
rngData.Offset(cell.Row - 5, _
i - 1).Column).Value) & _
Chr$(34) & ","
End If
' CubeCellValue 式に右かっこを追加します。
sCubeFormula = Left(sCubeFormula, _
Len(sCubeFormula) - 1) & ")"
' CubeCellValue 式をワークシートに書き込みます。
rngData.Offset(cell.Row - 5, i - 1) _
.FormulaR1C1 = sCubeFormula
End If
Next I
このセクションでは、残りの hot 列 (E3:H4) 内のセルをループします。
さまざまなセルの組み合わせで値を確認します。
値を検出すると、
sCubeFormula が更新されます。
その後、CubeCellValue 式が適切なセルに書き込まれます。
最後に、開いている If ステートメントを閉じると、
コードは hot 行範囲の次のセルに移動します。
End Sub
Function BracketIt(ByVal sCubeFormula As String) As String
' 文字列の先頭文字が左かっこ "[" ではない場合、
' 最初に左かっこ "[" を、最後に右かっこ "]" を追加します。
If Left(sCubeFormula, 1) <> "[" Then
sCubeFormula = "[" & sCubeFormula & "]"
End If
BracketIt = sCubeFormula
End Function
まとめ
Excel のピボットテーブルは、書き戻しやドリル スルーなどの高度な Analysis Services 機能を直接サポートしませんが、
これらの機能を Excel にシームレスに統合できます。
さらに、プログラムで OLAP の CubeCellValue アドインを使用すると、
ピボットテーブルを使用しないで動的な OLAP ベースのソリューションを作成できます。