● Excel2000VBA アクティブセルの列の空白セルを、前の行のセルの値で埋めるプログラム
このプログラムは・・・
→多段的なピボットテーブルの結果を他のシートにコピペして、更に何か集計をしたい時や、
→ピボットテーブルを半利用して「クロス集計表をリスト形式の表にできるだけ速く直す」処理をする場合・・・、
等々に使えます。
Excel音痴の僕が作ったので、ちゃっちいプログラムですし、遅いですし、それに直さないといけないところがいっぱいですが、かろうじて使えます。ExcelVBA初心者の方の何かのご参考になれば・・・。(って僕も初心者ですけど・・・(^^))
標準モジュールや、その他の場所でもいいのでコピペすれば使えます。
空白を同じ値で埋めたいとき、その列のどこかのセルをクリックしておき、また、どの行まで埋めていくかだけをあらかじめチェックして決めておけば使えます。
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 |
' ' '################################################################################################# 'アクティブセルの列の空白セルを、前の行のセルの値で埋めるプログラムです。 ' 'ピボットテーブルの結果を他のシートにコピペして、更に何か集計をしたい時や、 'ピボットテーブルを半利用して「クロス集計表をリスト形式の表にできるだけ速く直す」処理をする場合、 '等々に使えます。 ' '################################################################################################# Sub EmpCelFillPrevVle() Dim Celladr01 As String Dim FldNum01 As String Dim LastCelRowNum01 As Variant 'インプットボックスで使います。キャンセル時に文字列型のデータ(空文字)が代入されるのですが、その際変数が数値型だとエラーになってしまうため、バリアント型を使います。 Dim answ01 As Integer Dim cnt01 As Long Dim CellVle As Variant 'アクティブセルのセルアドレスを取得 Celladr01 = ActiveCell.Address 'Mid関数にて、アクティブセルの列番号(AとかBとかC・・・とか)を取得 FldNum01 = Mid(Celladr01, 2, 1) '次へ進んでいいか?最終行の行番号はチェックしてあるか?などのエンドユーザへの確認 'answ01 の中には、ユーザーがどのボタンを押したかの応えの情報(番号)が格納されます。 'これはMsgBox関数の中でのきまりで、「はい」が押されたら「6」、「いいえ」が押されたら「7」、と決められています。 answ01 = MsgBox("空白を埋める予定の列は " & FldNum01 & " 列 です。本当にこの列でいいですか?" _ & vbCrLf & "" _ & vbCrLf & "※最終セルの行番号をまだ調べてなかったら 「いいえ」で中断して調べてから" _ & vbCrLf & " 再操作してください。" _ & vbCrLf & "", vbYesNo + vbExclamation + vbDefaultButton2, "最後の確認") 'OK(=6=はい)なら次へ。中断(=7=ダメ=いいえ)ならプログラムを抜ける(=終わる)。 If answ01 = 6 Then ElseIf answ01 = 7 Then Exit Sub Else Exit Sub End If '最終セルの行番号(1とか、2とか、100とか、1000とか・・・)、 'つまりどこまでやるかをユーザーに聞いて取得する LastCelRowNum01 = InputBox("最終セルの行番号を入力してください。") 'インプットボックスでキャンセルされたときの処理 'MsgBoxキャンセルされると「空文字」の「""」を返してきます。 'で、それが変数LastCelRowNum01に代入されるので、もし '変数LastCelRowNum01に「""」が代入されていればキャンセルされた、 'と判断することができます。そのための処理をここでやります。 'それをやっておかないと、エラーが出てしまうのでエラー回避の意味でもやっておきます。 If LastCelRowNum01 = "" Then MsgBox "処理を中断します。" Exit Sub Else End If '●メイン処理:今居るセルが空白だったら、前のセルの値で埋めて、最終セルまで行く、という処理。 For cnt01 = 2 To LastCelRowNum01 '←行番号が「2」~「最終セルの番号」まで繰り返す、の意味です。 'アクティブセルの列の cnt01 行めに移動 Range(FldNum01 & cnt01).Select '空白かそうでないかを判断するために、 '変数 CellVle に 現在のセルの値を代入します。 CellVle = Range(FldNum01 & cnt01).Value 'ここでCellVle(アクティブセル) の値が空白かどうかを調べてそれぞれの自動処理をします。 If CellVle = "" Then 'もし「CellVle の値=今のセル」が空白だったら・・・ '今居るセルに、前のセルの値と同じ値を代入します。 Range(FldNum01 & cnt01).Value = Range(FldNum01 & cnt01 - 1).Value Else '空白じゃないときの処理。 '何もせずスルーします。 End If Next cnt01 '最終セルじゃなければ次のセルへ移動する準備をします(●メイン処理の最初「For cnt01 = 2 To LastCelRowNum01」の行に戻ります。) End Sub |
追記:後日判明
こんなバカなプログラム書かなくても、すぐにできることを知りました・・・。(ほんとうに恥ずかしいです。)僕はこんなことすら知らないExcel音痴です。
本当にすみませんでしたm( _ _ )m。
(1)列名が連続していることと、表の中の最低1つの列だけ、値がすべて埋まっていることを確認します。
(2)その表のどのセルでもいいのでクリックします。
(3)Ctrl+Shift+* で対象範囲を一括選択(全データが選択できるはずです)
もし、一括選択されなければ、Shiftキーを押しながら、
「左上の隅のセル→右下の隅のセル」を順番にクリックするなどして、
表全体を選択します。
※もし「表全体」じゃなくて、「1列分や2列分だけ」を処理したい場合は、
目的の列を必要な列数分、選択すればOKです。
(4)編集→ジャンプ→「セル選択」のボタンで『空白セル』に印を付けで「OK」します。
空白セルだけが水色に選択され、そのなかのカレントセル(1つだけ)が
白く表示されます。
このとき、カレントセル(白色)の一つ上のセルには、何らかの値が
入っている必要があります。
(空白セルの前のセルの値で、連続で埋めていきたいわけですので。)
一つ上のセルに値があれば、どこの空白セルをカレントセルにしてもOKです。
水色の範囲選択が解かれない状態のまま カレントセルを移動したいときは、
TABキーを押すか、Shift+TABを押して好きな場所に移動します。
もちろん、空白のセルに移動しますが、一つ上のセルに
何らかの値が入っている必要があります。
ここでは、例えば上の図の場合なら、TABキーなどを押して、
A2かB2のセルをカレントセルにします。
(5)カレントセルに算式を入力します。
空白のセルの、一つ上のセルを参照する式を書きます。
上の図で言うと、もしカレントセルが
A2なら「=A1」、
B2なら「=B1」、
と、数式を入力します。
(ただし、変換モードが英数字モードの場合は、
Enterキーを押さないようにご注意ください。
もし押してしまって水色の範囲選択が解かれて
しまった場合は、入力した数式を消してから、
また最初からやりなおします。)
(5)全空白セルに同じような式を一括入力するために、Ctrl+Enter をやります。
Ctrl+Enterすると、すべてのセルが、連続する値で埋まると思います。
※このような処理をよくされる方は、(1)~(4)・あるいは(2)~(4)をマクロの記録で記録し、リボンやクイックツールバーなどからボタン操作で呼び出せるようにしておくとよいと思います。
Selection.CurrentRegion.Select '一括で表の範囲を選択
Selection.SpecialCells(xlCellTypeBlanks).Select '空白セルだけを選択
か、
Selection.SpecialCells(xlCellTypeBlanks).Select '空白セルだけを選択
で行けそうです。
メニューをいちいち探してクリックしていくのも少し面倒ですので。
最期の、Ctrl+Enterはマクロ化しなくてもすぐできるのでそのまま何も書かなくて良いと思います。
※参考記事
『ExcelVBA:WordVBA:他のVBA:ビジネス基礎:VBAプログラム(マクロ)をクイックツールバーにボタンとして組み込む方法』
- 投稿タグ
- ExcelVBA, パソコンでの自動化, ピボットテーブル関連, 自動化