上のセルの値だけをコピーするマクロ(フィルターしていてもOK)
こんにちは。
派犬事務員のコロ子です。
上のセルの値だけをコピーしたい
Excelで上の行をコピーするショートカットキーの「Ctrl + D」。
便利だけど、フィルターされていると、実際の一行上のセルがコピーされるし、
また書式もコピーされるから色とか字体とかもコピーされる。
上のセルの値だけコピーしたいときあるよね?
例えば、
このような表で種目AAAでフィルターする。
この状態で「Ctrl + D」を押す。
すると、見えている状態(可視セル)の「123-456-789」でなくて、実際の一つ上のセルの「333-1123-456」が入力される。
(いつもフィルターしている事を忘れて失敗する)
また、こんな場合
上の行に色が付いている。
この場合は色ごとコピーされる。値だけでいいのに・・・。
上の値だけをコピーするショートカットキーが欲しい。
ということで、自作してみた。
一行上の可視セルの値だけをコピーするマクロ
①個人用マクロブック「PERSONAL.XLSB」にマクロを作成する
「PERSONAL.XLSB」にマクロを作成すれば、そのパソコンならどのエクセルファイルでも使える。
個人用マクロブックを一度も使っていない場合は「PERSONAL.XLSB」はないので作成する。
【作成方法】
開発タブのマクロの記録をクリック。
割り当てたいショートカットキーを入力する。
(コロ子は「Ctrl+b」にした。)
マクロの保存先に「個人用マクロブック」を選択してOKボタンをクリック。
何か適当に操作して、マクロの記録を終了する。
VBEエディタを見ると「PERSONAL.XLSB」が作成されている。
ちなみに「PERSONAL.XLSB」はWindows10では
C:\Users\[user]\AppData\Roaming\Microsoft\Excel\XLSTARTに作成される。
②「PERSONAL.XLSB」の標準モジュールにコードを書く。
【考え方】
①カーソル位置より上の可視セルの範囲を取得する(複数列ある場合は先頭列のみ)
②取得した範囲の各々のセルの行番号を配列に格納する
③配列で2番目に大きい行番号が一行上の可視セル。
(一番大きい行番号はカーソル位置)
④一行上の行番号の範囲(カーソル位置と同じ大きさの範囲)をコピー
⑤カーソル位置に値のみを張り付ける
【コード】
Sub PasteValue() Dim Myrange As Range Dim MyRow As Long Dim MyColumn As Long Dim VisibleRange As Range Set Myrange = Selection MyRow = Myrange.Row MyColumn = Myrange.Item(1).Column '選択範囲の先頭の列 '①MyColumn列の1行目からMyRow行目までの可視セルの範囲を取得 Set VisibleRange = _ Range(Cells(1, MyColumn), Cells(MyRow, MyColumn)).SpecialCells(xlCellTypeVisible) Dim buf As Range Dim RowArr() As Long Dim i As Long '②配列に行番号を格納する i = 1 For Each buf In VisibleRange ReDim Preserve RowArr(i) RowArr(i) = buf.Row i = i + 1 Next buf '③RowArr配列の2番目に大きい数字(一行上の行番号)を取得する Dim OneUpRow As Long OneUpRow = WorksheetFunction.Large(RowArr, 2) '④一行上の行番号の範囲をコピー Myrange.Offset(-(MyRow - OneUpRow), 0).Copy '⑤値のみ貼り付け Myrange.PasteSpecial Paste:=xlPasteValues Application.CutCopyMode = False End Sub
これで「Ctrl+b」で上の可視セルの値だけがコピーできる!
すごく便利だったから、職場で「このマクロいる?」ってみんなにメールしてみたけど、誰からも反応は無かった。
一般的な需要じゃないのか・・・。
ちなみに新しく「PERSONAL.XLSB」を作った場合は、エクセルを開くたびに、「PERSONAL.XLSB」も一緒に開くので表示タブの「表示しない」を選択し、非表示にしておけばOK。