ピボットテーブルで一旦まとめたデータを再度加工したい場合に使うマクロ。
たとえばピボットでデータを抽出して、それをデータベースにしてSUMIFなりVLOOKUPでもういちど集計・参照したい。
しかし、ピボットでデータ集計してしまうと、データ項目が全行に表示されない。そのため、SUMIFやVLOOKUPで集計・参照が出来ないわけです。
そこで、簡単にデータ項目を全行埋めるマクロを作りました。項目列の一番上(項目名が表示されているセル)をアクティブにしてマクロを実行するだけです。
Sub pivotdatafill()256列全部参照しますが、そんなに遅くはありません。1000行で1、2秒とかそんなもんでしょう。
'開始処理
Application.ScreenUpdating = False
'変数の定義
Dim copytxt As String 'コピー値格納用
Dim copyformat As String 'セル書式格納用
Dim startrownum As Long '開始行番号
Dim columnnum As Integer '処理対象の列番号
Dim i As Long 'ForNext文用
Dim j As Integer 'ForNext文用
'開始セル位置・行番号の取得
startrownum = ActiveCell.Row
columnnum = ActiveCell.Column
'データコピー(開始行番号から最終行番号まで)
For i = startrownum To 65536
'最終列(256列目)までをチェックし、すべて空白の場合処理を終了する
For j = 1 To 256
If Cells(i, j) <> "" Then
Exit For
ElseIf j = 256 Then
Application.ScreenUpdating = True
Exit Sub
End If
Next
If Cells(i, columnnum).Value = "" Then
Cells(i, columnnum).NumberFormatLocal = copyformat
Cells(i, columnnum).Value = copytxt
Else
copyformat = Cells(i, columnnum).NumberFormatLocal
copytxt = Cells(i, columnnum).Value
End If
Next
'終了処理
Application.ScreenUpdating = True
End Sub
1行ずつNumberFormatLocalをコピーするのは無駄のような気もしますので、そこはForNextの前に出してやるか、削っても良いと思います。
Excel2007を使っている人は65536行・256列のくだりを変えればいいと思います。
やっぱりこの需要ありますよね
使って頂いてうれしいです。
エクセルをそこまで使う人って少数派だと思うので、この需要がどれほどあるのかは疑問なんですが。