VBA・マクロ

【知らなくても使える】複数セルの値を一つのセルに貼り付ける(その逆も可能)マクロツール

 

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

 

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

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

 

そんな場面で、無駄な作業が効率化するために、もっと便利に簡単に行えるように『複数セルの値⇔一つのセルの値に変換して貼り付けるツール』をExcelマクロ(アドイン)で作りました。

 

当記事にはマクロの元になるExcelファイルがダウンロード可能で、VBAのコードも記事内に記載がありますので、Excel VBAやマクロが良く分からないという方でもすぐに使用できます

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

 

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

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

 

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

当ツールにて実現できること

  1. 複数セルにまたがってコピーした値を一つのセル内に貼り付ける
  2. 一つセルのコピーした値を複数のセルにまたがって貼り付ける
  3. 行と列を入れ替えて、一つのセルに貼り付ける
  4. 列と行をそれぞれ逆転させて貼り付ける

 

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

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

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

 

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

 

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

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

 

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

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

 

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

 

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

【簡単に使える】セル内の最初または最後に指定した値を貼り付けるアドイン Excel内でコピーをして貼り付けを行う際に、複数セルにまたがった範囲をコピーし、貼り付けた場合は、複数セルにコピーした値がその...

 

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

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

 

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

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

 

行と列を入れ替えて、一つのセルに貼り付ける場合

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

4ー3.任意のセルを選択して、『行と列を入れ替え』をクリックします。

指定した列にあった値を一つのセルに貼り付けることができました。

 

(対象のセルを行で指定した場合)

指定した行にあった値を一つのセル内に改行で区切って貼り付けることができました。

 

行と列をそれぞれ逆転させて貼り付ける場合

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

4ー4.任意のセルを選択して、『逆転させて貼り付け』をクリックします。

行と列をそれぞれ逆にした配置で、値を貼り付けることができました。

 

留意事項

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

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

 

使用する際の事前準備

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

 

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

 

準備の手順

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

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

 

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

 

リボンに「開発」タブが表示されていない場合は、以下を参照ください。
(参考サイト:記事「Excel VBAを始める前に、最初にやっておくべき初期設定内容はこれ」の『開発』タブを表示させる

 

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 c As Range
    Set c = Selection
    
    Dim clipboardValue As Variant
    clipboardValue = GetClipBoard
    
    clipboardValue = Replace(clipboardValue, vbCrLf, vbLf)
    clipboardValue = Replace(clipboardValue, Chr(9), SepValue)
    c.Value = clipboardValue

End Sub

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

    Dim i As Long, j As Long
    Dim c As Range
    Set c = Selection
    
    Dim clipboardValue As Variant
    clipboardValue = GetClipBoard
    
    Dim arrTabSpecifiedWord As Variant
    Dim arrLFSpecifiedWord As Variant
    
    clipboardValue = Replace(clipboardValue, vbCrLf, vbLf)
    clipboardValue = Replace(clipboardValue, vbCr, vbLf)
    arrLFSpecifiedWord = Split(clipboardValue, 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 Rowcol_Replace_onClick(control As IRibbonControl)

    Dim c As Range
    Set c = Selection
    
    Dim clipboardValue As Variant
    clipboardValue = GetClipBoard
    
    clipboardValue = Replace(clipboardValue, SepValue, Chr(8))  '区切り文字をバックスペース文字にいったん退避させる
    clipboardValue = Replace(clipboardValue, Chr(9), Chr(8))    'タブをバックスペース文字にいったん退避させる

    clipboardValue = Replace(clipboardValue, vbCrLf, SepValue)  'セルをまたぐ改行を区切り文字に変換する
    clipboardValue = Replace(clipboardValue, vbLf, SepValue)    'セル内の改行を区切り文字に変換する
    
    clipboardValue = Replace(clipboardValue, Chr(8), vbCrLf)    'バックスペース文字をセルをまたぐ改行に変換する
    
    c.Value = clipboardValue
    
End Sub

'===================================
'逆転させて貼り付けをした際の処理
'===================================
Sub ReversePaste_onClick(control As IRibbonControl)

    Dim i As Long, j As Long
    Dim c As Range
    Set c = Selection
    
    Dim clipboardValue As Variant
    clipboardValue = GetClipBoard
    
    Dim arrLFSpecifiedWord As Variant
    Dim arrTabSpecifiedWord As Variant
    
    arrLFSpecifiedWord = Split(clipboardValue, vbCrLf)
    arrLFSpecifiedWord = GetReverseValue(arrLFSpecifiedWord)

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

        arrTabSpecifiedWord = Split(arrLFSpecifiedWord(i), Chr(9))
        arrTabSpecifiedWord = GetReverseValue(arrTabSpecifiedWord)

        'クリップボードにある値において「区切り文字」の数だけ繰り返す
        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

'-------------------------
'汎用処理:クリップボードの中の値を取得する
'-------------------------
Function GetClipBoard()
    
    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
    
    GetClipBoard = tmpValue
    
End Function

'-------------------------
'汎用処理:配列の値を逆にする
'-------------------------
Function GetReverseValue(arrTmp As Variant)

    If IsArray(arrTmp) = False Then
        GetReverseValue = arrTmp
    End If
    
    Dim iStart As Long: iStart = LBound(arrTmp)     '配列の最初
    Dim iEnd As Long: iEnd = UBound(arrTmp)         '配列の最後
    Dim tempValue
    
    Do
        '添え字の大小が逆転もしくは一致した場合はループ終了
        If iStart >= iEnd Then
            Exit Do
        End If
        
        '配列要素の入れ替え
        tempValue = arrTmp(iStart)
        arrTmp(iStart) = arrTmp(iEnd)
        arrTmp(iEnd) = tempValue
        
        iStart = iStart + 1
        iEnd = iEnd - 1
    Loop
    
    GetReverseValue = arrTmp

End Function

 

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

 

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

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

 

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

 

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

 

正常に動作しない場合は、コメントいただければ幸いです。
また、このような業務効率化できるツールを以下に一覧でまとめてありますので、ご興味のある方はご覧ください。

業務効率化ツールの一覧(まとめ)

操作ごとにまとめて一覧で表示してあります。

Excel VBAを活用した便利マクロツール(まとめ)"Microsoft Excel"を使って業務効率化する際に使用できる便利なマクロツールを一覧で紹介します。 ...

 

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

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

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

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

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

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

 

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

コメントはこちら

  1. K より:

    Kです。
    希望していた通りのツールで大変助かります!
    仕事の効率がぐっと上がって、とても嬉しいです。
    ありがとうございます!

COMMENT

メールアドレスが公開されることはありません。 が付いている欄は必須項目です