【Excel VBA】セルの最初または最後に値を貼り付けるアドインツール(コピペですぐ使える)

Excel内でコピーをして貼り付けを行う際に、複数セルにまたがった範囲をコピーし、貼り付けた場合は、複数セルにコピーした値がそのまま貼り付けられます。

 

これを、セルの元の値はそのままにして、そこに追加で値を貼り付けたい場合は、関数を別のセルで使用して実現する等で大変手間がかかります。

 

貼り付け先のセルに既にある値はそのままにして、そのセルの最初か最後に貼り付けたい場合に、通常のExcelでそのような動作を実現する機能がなかったため、アドインで使用できるツール『セルの最初または最後に値を貼り付けるツール』をExcelマクロ(アドイン)で作成しました。

 

これを使用すれば定例業務の業務効率化が図れるかと思いますので、是非ご活用頂けたらと思います。

 

『セルの最初または最後に値を貼り付けるツール(アドイン)』の概要

ExcelにVBAコードを入れてマクロを作成し、アドインとして保存します。

 

そのアドインを取込むとリボンに「コピペ」というタブが表示されるので、コピーした値または文字を指定して、任意のセルを選択した状態で、貼り付けボタンを押すことで該当のマクロを実行でき、元のセルの値をそのままで、セルの最初か最後に値を貼り付けることができます。

 

当ツールの使用方法

基本的な機能、操作方法の説明

1.セルの最初または最後に貼り付けを実行したい(マクロを実行したい)任意のExcelファイルを開きます。

2.「開発」タブの「Excelアドイン」より、作成したアドインファイルを指定(参照)します。

 

3.リボンにある「コピペ」から、「値」→「セルからコピー」を選択し、セルを選択した状態でコピーをします。

 

4.貼り付けたいセルを選択して、「コピペ」タブにある「セル内に貼り付け」を選択します。

選択したセルに既にある値はそのままで、セルの値の最初にコピーしたセルの値が貼り付けられました。

※貼り付ける位置は、初期値として「セルの最初」になっているため、最初に貼り付けられます

 

4ー2.また、「値」→「文字を指定」を選択し、指定文字に任意の値を入力した状態で、セルを選択して「セル内に貼り付け」をクリックします。

すると、コピーした値でなく、「指定文字」で指定した文字がセル内の最初に貼り付けられました。

 

補足

「位置」→「セルの最後」を選択し、指定文字に任意の値を入力して、セルを選択した状態で「セル内に貼り付け」をクリックすると、貼り付ける位置を「セルの最初」でなく「セルの最後」に貼り付けることができます。

 

つまり、貼り付ける際の設定として、それぞれ以下の値を指定することができます。

貼り付ける位置
  • セルの最初 ・・・セルに既にある値の”一番最初”に、指定した値を貼り付けることができます
  • セルの最後 ・・・セルに既にある値の”一番最後”に、指定した値を貼り付けることができます
貼り付ける値
  • セルをコピー ・・・セルなどをコピーしてクリップボードにある値を貼り付けることができます
  • 文字を指定 ・・・「指定文字」に記入した値を貼り付けることができます

 

留意事項

セルからコピーした値を貼り付ける場合、複数のセルをコピーした状態で、一つのセルを選択して貼り付けを行うとコピーしたセル分(複数セル分)貼り付けられます。(※Excelで複数セルをコピーし、一つのセルを選択して貼り付けをした場合と同じ挙動です)

 

使用する際の事前準備

このページの下部にある「Excelファイルのサンプル」からExcelファイルを取得し、「準備の手順」内にあるVBAコードを取得したExcelファイルに記載して保存すれば、すぐに当ツールを使用できます。

 

以下にその手順を説明していきます。

 

準備の手順

1.サンプルのダウンロードはこちら」からサンプル(Excelファイル)をダウンロードし、ファイルを開きます。

※インターネットにあるマクロファイルをダウンロードすることはセキュリティ上リスクがあるので、マクロ無しExcelファイルを公開しています

2.ダウンロードしたExcelファイルの上部にあるリボンの「開発」タブから「visual basic」を選択して、VBE(Visual Basic Editor)を起動させます。

 

リボンに「開発」タブが表示されていない場合は、以下を参照ください。

 

3.「プロジェクト」に「標準モジュール」を追加して、追加された「Module1」にVBAコードを記載します。

 

以下にあるVBAコードを「Module1」内のエディターにコピーして貼り付けます。

 

VBAのソースコードはこちら

以下のVBAコードをコピーして、「Module1」内のエディターに貼り付けます。

※VBAコードの右上のアイコンをクリックするとソースコードをコピーできます

Option Explicit

'-----(設定値)------------------------
Private Const PLACE_FIRST = "1"         '1.セルの最初(貼り付け位置)
Private Const PLACE_END = "2"           '2.セルの最後(貼り付け位置)
Private Const SELECT_CELL = "1"         '3.セルからコピー(コピーする値)
Private Const SELECT_WORD = "2"         '4.指定文字(コピーする値)
'---------------------------------------

Private RbRibbon As IRibbonUI           'リボン
Private SetPlace As String              '貼り付け位置
Private SetCopyType As String           '貼り付ける値
Private SpecifiedWord As String         '指定文字(コピーする値)
Private CellValue As String             'コピーしたセルの値(コピーする値)

'===================================
'リボンの初期処理
'===================================
Sub onLoad(ribbon As IRibbonUI)

    'リボンの表示を更新できるようにするためにリボンをセットする
    Set RbRibbon = ribbon
    RbRibbon.Invalidate
    SetPlace = PLACE_FIRST          '初期値:貼り付け位置 セルの最初
    SetCopyType = SELECT_CELL       '初期値:貼り付ける値 セルからコピー
    
End Sub

'===================================
'セル内に貼り付ける際の処理
'===================================
Sub Paste_onClick(control As IRibbonControl)

    Dim tmpValueArr() As Variant
    Dim cntRow As Long, cntCol As Long, i As Long, j As Long
    Dim tmpValue As String

    Dim c As Range
    Set c = Selection
    
    Dim obj As Object
    Set obj = CreateObject("new:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}")
        
    '貼り付ける値をセルからコピーとした場合
    If SetCopyType = SELECT_CELL Then

        obj.GetFromClipboard
        
        'クリップボードのコピーデータが存在する場合
        If obj.GetFormat(1) Then
        
            '最後の改行を取り除く処理
            CellValue = TrimLWord(obj.getText)
            
        Else
            CellValue = ""
        End If
        
        Dim arrTabSpecifiedWord As Variant
        Dim arrLFSpecifiedWord As Variant
        
        arrLFSpecifiedWord = Split(CellValue, vbCrLf)
        
        'クリップボードにある値において改行の数だけ繰り返す
        For i = 0 To UBound(arrLFSpecifiedWord)
        
            arrTabSpecifiedWord = Split(arrLFSpecifiedWord(i), vbTab)
            
            'クリップボードにある値においてタブの数だけ繰り返す
            For j = 0 To UBound(arrTabSpecifiedWord)
            
                'セル内改行がある場合はダブルクォーテーションが存在するので取り除く処理
                arrTabSpecifiedWord(j) = TrimDQ(arrTabSpecifiedWord(j))
                
                If SetPlace = PLACE_FIRST Then
                    ActiveSheet.Cells(c.Row + i, c.Column + j).Value = arrTabSpecifiedWord(j) & ActiveSheet.Cells(c.Row + i, c.Column + j).Value
                Else
                    ActiveSheet.Cells(c.Row + i, c.Column + j).Value = ActiveSheet.Cells(c.Row + i, c.Column + j).Value & arrTabSpecifiedWord(j)
                End If
            Next
        Next
            
    '貼り付ける値を指定文字にした場合
    Else
    
        '指定文字に値がなければ処理を終了する
        If SpecifiedWord = "" Then
            Exit Sub
        End If
        
        '貼り付ける際に選択されたセルが一つの場合は単純に貼り付ける
        If Selection.Cells.Count = 1 Then
            
            If SetPlace = PLACE_FIRST Then
                c.Value = SpecifiedWord & c.Value
            Else
                c.Value = c.Value & SpecifiedWord
            End If
        
        '貼り付ける際に選択されたセルが複数の場合は全てのセルに指定文字を貼り付ける
        Else
            tmpValueArr = c.Value
            cntRow = UBound(tmpValueArr)
            cntCol = UBound(tmpValueArr, 2)
        
            For i = 1 To cntRow
                For j = 1 To cntCol
        
                    If SetPlace = PLACE_FIRST Then
                        tmpValueArr(i, j) = SpecifiedWord & tmpValueArr(i, j)
                    Else
                        tmpValueArr(i, j) = tmpValueArr(i, j) & SpecifiedWord
                    End If
        
                Next
            Next
            c.Value = tmpValueArr
            
        End If
    End If
    
End Sub

'===================================
'貼り付け位置(セルの最初、セルの最後)を選択した際の処理
'===================================
Sub TglPaste_onSel(control As IRibbonControl, pressed As Boolean) ' トグルボタンのクリック処理

    Select Case control.ID
    
        Case "tglBtn_pasteFirst"      'セルの最初を選択した場合
            SetPlace = PLACE_FIRST
        
        Case "tglBtn_pasteEnd"        'セルの最後を選択した場合
            SetPlace = PLACE_END
        
    End Select
    
    RbRibbon.InvalidateControl ("tglBtn_pasteFirst")
    RbRibbon.InvalidateControl ("tglBtn_pasteEnd")
End Sub

'-------------------------
'貼り付け位置を変更する際に行われる処理
'-------------------------
Sub TglPaste_getPressed(control As IRibbonControl, ByRef returnedVal)

    Select Case control.ID
    
        Case "tglBtn_pasteFirst"    'セルの最初を選択した場合
        
            If SetPlace = "" Then
                returnedVal = True
            Else
                If SetPlace = PLACE_FIRST Then
                    returnedVal = True
                Else
                    returnedVal = False
                End If
            End If
        
        Case "tglBtn_pasteEnd"      'セルの最後を選択した場合
            
            If SetPlace = "" Then
                returnedVal = False
            Else
                If SetPlace = PLACE_END Then
                    returnedVal = True
                Else
                    returnedVal = False
                End If
            End If
        
    End Select
    
End Sub

'===================================
'貼り付ける値(セルからコピー、指定文字)を選択した際の処理
'===================================
Sub TglPoint_onSel(control As IRibbonControl, pressed As Boolean)

    Select Case control.ID
        
        Case "tglBtn_tgtCell"               'セルからコピーを選択した場合
            SetCopyType = SELECT_CELL
        
        Case "tglBtn_tgtWord"               '指定文字を選択した場合
            SetCopyType = SELECT_WORD
        
    End Select
    
    RbRibbon.InvalidateControl ("tglBtn_tgtCell")
    RbRibbon.InvalidateControl ("tglBtn_tgtWord")
    RbRibbon.InvalidateControl ("edbox_tgtWord")
End Sub

'-------------------------
'貼り付ける値を変更する際に行われる処理
'-------------------------
Sub TglCopy_getPressed(control As IRibbonControl, ByRef returnedVal)

    Select Case control.ID
    
        Case "tglBtn_tgtCell"       'セルからコピーを選択した場合
        
            If SetCopyType = "" Then
                returnedVal = True
            Else
                If SetCopyType = SELECT_CELL Then
                    returnedVal = True
                Else
                    returnedVal = False
                End If
            End If
        
        Case "tglBtn_tgtWord"       '指定文字を選択した場合
        
            If SetCopyType = "" Then
                returnedVal = False
            Else
                If SetCopyType = SELECT_WORD Then
                    returnedVal = True
                Else
                    returnedVal = False
                End If
            End If
        
    End Select
    
End Sub

'-------------------------
'指定文字のテキスト内容を取得する際の処理
'-------------------------
Sub TgtWord_getText(control As IRibbonControl, ByRef returnValue)
    '初期値なし
End Sub

'-------------------------
'指定文字に変更があった際の処理
'-------------------------
Sub TgtWord_onChange(control As IRibbonControl, text As String)
    SpecifiedWord = text
End Sub

'-------------------------
'指定文字の活性/非活性を変更する処理
'-------------------------
Sub TgtWord_getEnabled(control As IRibbonControl, ByRef returnedVal)
    If SetCopyType = "" Or SetCopyType = SELECT_WORD Then
        returnedVal = True
    Else
        returnedVal = False
    End If
End Sub

'-------------------------
'汎用処理:文字列の最後に改行があれば取り除く
'-------------------------
Function TrimLWord(strTmp As String)

    If Right(strTmp, 1) = vbLf Then
        strTmp = Left(strTmp, Len(strTmp) - 2)
    End If
    
    TrimLWord = strTmp
    
End Function

'-------------------------
'汎用処理:ダブルクォーテーションを取り除く(セル内改行の場合)
'-------------------------
Function TrimDQ(strTmp As Variant)

    If InStr(strTmp, vbLf) > 0 And Right(strTmp, 1) = """" And Left(strTmp, 1) = """" Then
        
        strTmp = Left(strTmp, Len(strTmp) - 1)
        strTmp = Right(strTmp, Len(strTmp) - 1)
        strTmp = Replace(strTmp, """""", """")
        
    End If
    
    TrimDQ = strTmp
    
End Function

 

4.ファイルを保存する際は「Excelアドイン(*.xlam)」を選択して、保存します。

 

これで事前準備は完了です。

あとは「当ツールの使用方法」で記載された方法でツールを実行できます。

 

また、このようなExcelVBAを用いた業務効率化を行うときに、以下の書籍が初心者向けでとても参考になると思いますので、良かったらご参照ください。

 

なお、当マクロの開発環境として、OSは “Windows10” 、Excelのバージョンは “Microsoft Office 365″ で行っており、当環境では動作確認ができていますが、他のすべての環境で正常に動作するかは確認できていません。

 

正常に動作しない場合は、コメントいただければ幸いです。

 

当ツールのダウンロードはこちら

下記よりExcelファイルをダウンロードして、記事の途中にありました VBAのソースコードをツール内に組み込んで使用してください。

 

【Excel VBA】セルの最初または最後に値を貼り付けるアドインツール

※インターネットにあるマクロファイルをダウンロードすることはセキュリティ上リスクがあるので、マクロ無しExcelファイルを公開しています

 

他に要望等ありましたら、可能な限り改修等を対応しますのでコメント頂ければと思います

 

<このツールが『結構使える!』と思ったら、下のグッドボタンを押していただけたら幸いです>

コメントを残す

CAPTCHA