ざっ記

また間が空いてしまった。
なので、というわけでもないがリハビリ替わりで軽く雑記など...



gooブログのアクセス解析って全然高度な解析は無いけど（何となく見てる方が少ないのがわかるだけ）XD
先月ちょっと異常値があった...？



普段100～200pvだしなー・・しかもGooglebot込みで。



どう考えても集計誤りだよなぁ...
でもコーゲキ受けてたりしてたらちょっとコワい :D



コワいと言えばこっちの方が怖いけど。
■結合セル行高調整...


http://shmilyandmeng.spaces.live.com/blog/
『转』ってなん？

■PivotTable Field Listの修復

最近2003を使うようになって遭遇した事例。
何が原因か良くわからないのだが、ピボットテーブルの[フィールドリスト]の項目名が見えなくなったり、フォントの大きさが変わったりする不具合があるらしい。
昨日は項目名が全く見えず、ちょとイラっ...だったのである -"-
support.microsoft.com でも見つけられず...
http://oshiete1.goo.ne.jp/qa3990755.html
このQAを参考にして試してみたけど改善せず...
もしかして（ツール＞ユーザー設定＞オプション＞初期状態に戻す）の後、Excel再起動したら良かったのかな...？
他に、xlbファイル再構築で直るかも、という情報もあったのだけどカスタマイズをリセットしたくなかったので、結局VBAで対処してみたのであった。


▲こんなの。

CommandBars("PivotTable Field List").Reset

で該当するツールバーだけをResetします。
イミディエイトウィンドウでやってもOK。

ペーストしてEnter。

実行直後はこんな。


一応、直ってるみたい...


#（2009.07.11 追記）
また発生したので確かめてみました。
>もしかして（ツール＞ユーザー設定＞オプション＞初期状態に戻す）の後、Excel再起動したら良かったのかな...？
Excel再起動で解消しました。

#（2010.03.05 追記）
...ぁ、いや...何もしなくてもExcel再起動だけで解消するみたい...orz

■ジャグ配列をシートに書き込む

ジャグ配列といっても、単純なケースでの話。



多段階配列、いわゆる配列の配列なのでそのままワークシートに書き込む事はできません。
でも１次元配列の中に格納されている配列が１次元配列か、最初の次元が単一の２次元配列の時、
かつ、中の配列の要素数が一定の場合に限りますが、以下のように書き込みできます。

Sub sample()
　　Dim r As Range
　　Dim i As Long
　　Dim aryX(1)
　　Dim aryY(1)
　　Dim x(2)
　　Dim y(0, 2)

　　For i = 0 To 2
　　　　x(i) = i
　　　　y(0, i) = i
　　Next
　　For i = 0 To 1
　　　　aryX(i) = x
　　　　aryY(i) = y
　　Next

　　Stop
　　Set r = Range("A1").Resize(2, 3)

　　'Transpose関数
　　With WorksheetFunction
　　　　r.Value = .Transpose(.Transpose(aryX))
　　　　r.ClearContents
　　　　r.Value = .Transpose(.Transpose(aryY))
　　End With

　　'FormulaArrayプロパティ
　　r.ClearContents
　　r.FormulaArray = aryX
　　r.ClearContents
　　r.FormulaArray = aryY

　　Set r = Nothing
End Sub

前述条件のような単純な多段階配列の場合、
ワークシートTranspose関数を使って２次元配列に整理し直す事ができます。
また、FormulaArrayプロパティを使う事によって配列のままワークシートに書き込む事ができます。
よく見かけるのはTransposeを２回使う手法ですね。
FormulaArrayプロパティの方は使えない事はないけど、激遅なので使わないほうが良いです。
ジャグ配列というと、DictionaryのItemに配列をセットするパターンにも繋がるので、ちょっとDictionaryを使ってみた計測コード。

Option Explicit

Sub test()
　　Const rn As Long = 1000
　　Const cn As Long = 5
　　Dim dic　As Object
　　Dim i　　As Long
　　Dim j　　As Long
　　Dim n　　As Long
　　Dim tmp(1 To cn)
　　Dim t As Single

　　Set dic = CreateObject("scripting.dictionary")
　　For i = 1 To rn
　　　　For j = 1 To cn
　　　　　　n = n + 1
　　　　　　tmp(j) = n
　　　　Next
　　　　dic(i) = tmp
　　Next

　　t = Timer
　　With Application
　　　　Sheets.Add.Cells(1).Resize(rn, cn).Value = _
　　　　　　　　　　　　　 .Transpose(.Transpose(dic.items))
　　End With
　　Debug.Print "Transpose", Timer - t

　　t = Timer
　　Sheets.Add.Cells(1).Resize(rn, cn).FormulaArray = dic.items
　　Debug.Print "FormulaArray", Timer - t

　　t = Timer
　　Sheets.Add.Cells(1).Resize(rn, cn).Value = AryLoop(dic.items)
　　Debug.Print "AryLoop", Timer - t
End Sub
'---------------------------------------------------------------------
Function AryLoop(Ary)
　　Dim Lx As Long
　　Dim Ly As Long
　　Dim Ux As Long
　　Dim Uy As Long
　　Dim i　As Long
　　Dim j　As Long

　　Ly = LBound(Ary)
　　Uy = UBound(Ary)
　　Lx = LBound(Ary(Ly))
　　Ux = UBound(Ary(Ly))

　　ReDim v(Ly To Uy, Lx To Ux)
　　For i = Ly To Uy
　　　　For j = Lx To Ux
　　　　　　v(i, j) = Ary(i)(j)
　　　　Next
　　Next
　　AryLoop = v
End Function

1,000×10配列で

Transpose      0.046875 
FormulaArray   4.234375 
AryLoop        0.046875 

こんな結果です。[winXPsp2/xl2003sp3]

■Application.InputBoxで他Book参照

Type 8 のApplication.InputBoxメソッドを使ってセル参照を取得する時、InputBox表示中にBookを切り替えるにはメニューの[ウィンドウ]から切り替えます。
またはウィンドウの整列や、最大化解除で別Bookを表示させたりしても良いです。
[Ctrl]+[TAB]キーや[ウィンドウをタスクバーに表示]させて選択しても切り替わらないので、できないという思い込みが先行しがちな事があるかも？

Sub test()
　　Dim r As Range

　　On Error Resume Next
　　Set r = Application.InputBox("他Bookの選択は ワークシートメニューバーの" _
　　　　　　　　　　　　　　　 & "[ウィンドウ(W)]で できます。", Type:=8)
　　On Error GoTo 0
　　If Not r Is Nothing Then
　　　　MsgBox r.Address(external:=True)
　　　　Set r = Nothing
　　End If
End Sub

■透明グラフをクリックして直下セル選択

#もう１ヶ月ですか。早いですね...（月刊チルダ）と化してきた感が...XD

さて、しばらく前のシート上のグラフに関してのお題です。
『グラフを透過させ、プロットエリアx軸y軸の目盛線をセル枠線にピッタリと合わせたい。
　また、そのグラフをクリックして、下にあるセルを編集できるようにしたい。』
...というのがありました。

サンプルコード提示はしませんでしたが、アドバイスとして
A)シート上にBuildFreeformメソッドを使って線を描画しグラフもどきに見立てる。
B)グラフ上に幾つかの透明のシェイプを被せ、セルへのハイパーリンクを設定する。
C)グラフ上に[コントロールツールボックス]のラベルを被せてMouseUpイベントを利用する。
D)グラフにマクロを登録し、クリック時のマウス座標から選択セルを導く。
など幾つかの案を提案しました。

実用的かどうかはさておき、(C)のセンで試したコードのメモ的アップ。
シート上のMSForms.Labelの透明化はちょっとクセがありそう。
コードでLabel自体を追加するとどうもうまくいかず、手動で作成してあげないとダメなん？...

'標準Module
Option Explicit

Sub try()
　　'事前にActiveSheetにMSForms.Labelを１コ作成しておく _
　　 必要があります。配置は適当でok
　　Dim r1 As Range　'Chart範囲
　　Dim r2 As Range　'SourceData範囲
　　Dim L　As Double
　　Dim T　As Double

　　With ActiveSheet
　　　　'Chart範囲の設定とダミーデータセット
　　　　Set r1 = .Range("B2").Resize(20, 20)
　　　　r1.RowHeight = 15
　　　　r1.ColumnWidth = 3
　　　　Set r2 = r1.Offset(20).Resize(1)
　　　　r2.Formula = "=INT(RAND()*100)"

　　　　'チャート作成しセル枠線に合わせ、透明化
　　　　With .ChartObjects.Add(r1.Left - 10, _
　　　　　　　　　　　　　　　 r1.Top - 10, _
　　　　　　　　　　　　　　　 r1.Width + 20, _
　　　　　　　　　　　　　　　 r1.Height + 20)
　　　　　　.ShapeRange.ZOrder msoSendToBack
　　　　　　With .Chart
　　　　　　　　.ChartType = xlLine
　　　　　　　　.HasLegend = False
　　　　　　　　.SetSourceData r2
　　　　　　　　With .Axes(xlValue)
　　　　　　　　　　.MinimumScale = 0
　　　　　　　　　　.MaximumScale = 100
　　　　　　　　　　.Delete
　　　　　　　　End With
　　　　　　　　.Axes(xlCategory).Delete
　　　　　　　　With .ChartArea
　　　　　　　　　　.Border.LineStyle = 0
　　　　　　　　　　.Interior.ColorIndex = xlNone
　　　　　　　　　　L = .Left
　　　　　　　　　　T = .Top
　　　　　　　　End With
　　　　　　　　With .PlotArea
　　　　　　　　　　.Left = 10 - L
　　　　　　　　　　.Top = 10 - T
　　　　　　　　　　.Width = r1.Width
　　　　　　　　　　.Height = r1.Height
　　　　　　　　　　.Interior.ColorIndex = xlNone
　　　　　　　　End With
　　　　　　End With
　　　　End With

　　　　'Labelを透明化し、PlotAreaに被せる
　　　　With .Label1
　　　　　　.Left = r1.Left
　　　　　　.Top = r1.Top
　　　　　　.Width = r1.Width
　　　　　　.Height = r1.Height
　　　　　　.Caption = ""
　　　　　　.BackStyle = 0 'fmBackStyleTransparent
　　　　End With
　　End With

　　Set r1 = Nothing
　　Set r2 = Nothing
End Sub

（実行後）


シートモジュールには以下のコードを。

'Sheet Module
Option Explicit

Private Sub Label1_MouseUp(ByVal Button As Integer, _
　　　　　　　　　　　　　 ByVal Shift As Integer, _
　　　　　　　　　　　　　 ByVal X As Single, _
　　　　　　　　　　　　　 ByVal Y As Single)
　　Dim ix As Long
　　Dim iy As Long

　　With Me.Label1
　　　　'fmButtonLeft
　　　　If Button = 1 Then
　　　　　　'マウス座標を元に起点セルからのOffset位置を算出
　　　　　　ix = Int(X * 20 / .Width)
　　　　　　iy = Int(Y * 20 / .Height)
　　　　　　Me.Range("B2").Offset(iy, ix).Select
　　　　End If
　　　　'Visible = False/TrueでLabelのTransparentを有効化
　　　　.Visible = False
　　　　.Visible = True
　　End With
End Sub