【Excel VBA】複数セルの値⇔一つのセルの値へ貼り付けるツール(コピペですぐ使える)

 

Excel内で複数セルにある値を一つのセル内に貼り付けする場合や、逆に一つのセルにある値を複数セルに分割して貼り付ける場合はどのような操作をしていますでしょうか。

 

リボンの「データ」から区切り文字を選択して分割する。という操作か、

フラッシュフィルを使用して分割した操作を繰り返す。という操作か、、、

 

上記のような操作で行っていると思いますが、もっと便利に簡単に行えるように『複数セルの値⇔一つのセルの値に変換して貼り付けるツール』をExcelマクロ(アドイン)で作成しました。

 

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

 

『複数セルの値⇔一つのセルに変換して貼り付けるツール(アドイン)』の概要

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

 

そのアドインを取込むとリボンに『コピペ』のタブが表示されるので、対象のセルの値をコピーした状態から、それぞれ行いたい貼り付け(『一つのセルに貼り付け』、または『分割して貼り付け』)に該当するボタンを押すことで該当のマクロを実行でき、値を結合または分割してセルに貼り付けることができます。

 

当ツールの使用方法

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

1.複数セルの値を一つのセルに、または一つのセルの値を複数セルに貼り付けたい任意のExcelファイルを開きます。

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

 

リボンに『コピペ』が表示されて、クリックすると『特殊な貼り付け』が表示されます。

 

 

複数セルの値を結合して、一つのセルに貼り付ける場合

3.対象のセルを選択して、コピー(ショートカットキー:Ctrl+C)します。

 

4.任意のセルを選択して、『一つのセルに貼り付け』をクリックします。

複数セルの値が結合されて、一つのセルに貼り付けられました。

 

また、年、月、日に分かれたデータをコピーして、一つのセルに貼り付けると、日付形式で値の貼り付けがされます

 

一つのセルに貼り付けるのでなく、分かれたセルの状態のままで、セル内の値の前後に追加で値を貼り付ける場合は、以下のアドインをお試しください。

 

 

一つのセルの値を分割して、複数セルに貼り付ける場合

3ー2.対象のセルを選択して、コピー(ショートカットキー:Ctrl+C)します。

 

4ー2.任意のセルを選択して、区切り文字に『/』(スラッシュ)を入力して、『分割して貼り付け』をクリックします。

改行されて、かつ『/』(スラッシュ)で区切られたてコピーした値が貼り付けられます。

 

留意事項

複数セルを選択してコピーした状態で、『分割して貼り付け』をクリックした場合

一つのセルをコピーしなくても改行と『区切り文字』を基に分割してそれぞれのセルに貼り付けられます。

 

使用する際の事前準備

このページの下部にある「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 SEPARATE_VALUE = ","      '1.区切り文字の初期値
'---------------------------------------

Private SepValue As String              '区切り文字

'===================================
'一つのセルに貼り付けをした際の処理
'===================================
Sub OneCellPaste_onClick(control As IRibbonControl)

    Dim i As Long, j As Long
    Dim c As Range
    Set c = Selection
    
    Dim tmpValue As Variant
    
    Dim obj As Object
    Set obj = CreateObject("new:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}")
    
    obj.GetFromClipboard
    
    'クリップボードのコピーデータが存在する場合
    If obj.GetFormat(1) Then
    
        '最後の改行を取り除く処理
        tmpValue = TrimLWord(obj.getText)
        
        'セル内のダブルクォーテーションを取り除く処理
        tmpValue = TrimDQ(tmpValue)
        
    Else
        tmpValue = ""
    End If
    
    tmpValue = Replace(tmpValue, vbCrLf, vbLf)
    tmpValue = Replace(tmpValue, Chr(9), SepValue)
    c.Value = tmpValue

End Sub

'===================================
'複数のセルに貼り付けをした際の処理
'===================================
Sub SplitPaste_click(control As IRibbonControl)

    Dim i As Long, j As Long
    Dim c As Range
    Set c = Selection
    
    Dim tmpValue As Variant
    
    Dim obj As Object
    Set obj = CreateObject("new:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}")
    
    obj.GetFromClipboard
    
    'クリップボードのコピーデータが存在する場合
    If obj.GetFormat(1) Then
    
        '最後の改行を取り除く処理
        tmpValue = TrimLWord(obj.getText)
        
        'セル内のダブルクォーテーションを取り除く処理
        tmpValue = TrimDQ(tmpValue)
        
    Else
        tmpValue = ""
    End If
    
    Dim arrTabSpecifiedWord As Variant
    Dim arrLFSpecifiedWord As Variant
    
    tmpValue = Replace(tmpValue, vbCrLf, vbLf)
    tmpValue = Replace(tmpValue, vbCr, vbLf)
    arrLFSpecifiedWord = Split(tmpValue, vbLf)

    'クリップボードにある値において改行の数だけ繰り返す
    For i = 0 To UBound(arrLFSpecifiedWord)

        arrTabSpecifiedWord = Split(arrLFSpecifiedWord(i), SepValue)

        'クリップボードにある値において「区切り文字」の数だけ繰り返す
        For j = 0 To UBound(arrTabSpecifiedWord)

            ActiveSheet.Cells(c.Row + i, c.Column + j).Value = arrTabSpecifiedWord(j)

        Next
    Next
    
End Sub

'-------------------------
'区切り文字のテキスト内容を取得する際の処理
'-------------------------
Sub Edtb_getText(control As IRibbonControl, ByRef returnValue)
    SepValue = SEPARATE_VALUE
    returnValue = SepValue
End Sub

'-------------------------
'区切り文字に変更があった際の処理
'-------------------------
Sub Delimiter_onChange(control As IRibbonControl, text As String)
    SepValue = text
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, Chr(34) & Chr(34)) > 0 Then
        
        'セル内にダブルクォーテーションをバックスペース文字にいったん退避させる
        strTmp = Replace(strTmp, Chr(34) & Chr(34), Chr(8))
        
        'ダブルクォーテーションを取り除く
        strTmp = Replace(strTmp, Chr(34), "")
        
        'バックスペース文字をダブルクォーテーションに変換する
        strTmp = Replace(strTmp, Chr(8), Chr(34))
    
    Else
        
        'ダブルクォーテーションをなくす
        strTmp = Replace(strTmp, Chr(34), "")
    
    End If
    
    TrimDQ = strTmp
    
End Function

 

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

 

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

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

 

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

 

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

 

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

 

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

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

 

【Excel VBA】複数セルの値⇔一つのセルの値へ貼り付けるアドインツール

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

 

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

 

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

コメントを残す

CAPTCHA