「今さら」なんてない

「自分にもできそう」を伝播させるブログ

Excel VBA 行の追加・削除

こちらの記事で紹介したExcelタスク管理ツールの補助機能の紹介です。
はじめての方はまずはこちらの記事をどうぞ。 yoshino-ya.hatenablog.com



それでは本題です。

行の追加・削除は左端のエリアでの右クリックメニューやExcel標準のショートカットからできますが面倒なので作りました。

f:id:yoshino-ya:20180618040624p:plainf:id:yoshino-ya:20180618040618p:plain
左:右クリックメニューから / 右:ショートカットから

僕は

行の追加:Shift+Enter

行の削除:Ctrl+Shift+Enter

に割り当てています。

やること

  • 下記コードを標準モジュールに貼り付ける

  • ショートカットを割り当てる

ショートカット割当方法はこちらをどうぞ

yoshino-ya.hatenablog.com

標準モジュールに貼り付けるコード

Option Explicit

Sub 行の追加()
    Dim Rs As Long, Re As Long '開始・終了行
    Dim Rlast As Long
    Dim r As Long, C As Long
    
    '画面更新OFF
        Application.ScreenUpdating = False
    
    'クリップボードのクリア
        Application.CutCopyMode = False
    
    'メイン
        Rs = ActiveCell.Row
        Rows(Rs + 1).Insert Shift:=xlDown
        Cells(Rs + 1, "Q").Value = Cells(Rs, "Q").Value
    
    '画面更新ON
        Application.ScreenUpdating = True


End Sub

Sub 行の削除()
    Dim Rs As Long, Re As Long  '開始・終了行
    Dim rc As Integer           'msgbox用戻り値
    Dim Rlast As Long
    Dim r As Long, C As Long
    
    '画面更新OFF
        Application.ScreenUpdating = False

    
    Rs = ActiveCell.Row
    If WorksheetFunction.CountA(Cells(Rs, 1), Cells(Rs, 3)) <> 0 Then
        rc = MsgBox("この行にはデータが存在します。この行を削除しますか?", vbYesNo + vbQuestion, "確認")
    Else: rc = vbYes
    End If
    If rc = vbYes Then
        'MsgBox "削除します"
        Rows(Rs).Delete
    End If
    
    '画面更新ON
        Application.ScreenUpdating = True
    
End Sub

以上です。