【VBA】複数選択したセルを、特定列の最終行に追加していく(特定のセル内に追加していく)

範囲で選択した場合、複数のセルを選択した場合、あるいはその組み合わせを行った場合などは、「セルの番地を1つずつ取り出す」と、応用が利きます。

例えば、

①複数選択したセルを、特定の行の下に追加して行く
②複数選択したセルを、特定のセルの中に追加して行く

という事例を見てみます。

Excelの完成図

図で見ると分かり易いですね。

①左のボタンは、最終行に追加されます。
②右のボタンは、セル内に追加されます。

コード

①複数選択したセルを、最終行に追加するコード

Sub 選択セルの値_特定列に並べて追加()
  
    Dim 選択範囲 As Range
    Dim セル番地 As String


    'セルが選択状態ではない場合はマクロ終了
    '例:図などのオブジェクトが選択状態で、セルが選択状態にない場合、など
    If TypeName(Selection) <> "Range" Then
        Exit Sub
    End If


    '選択範囲(Selection)を、変数 [範囲選択] に代入
    For Each 選択範囲 In Selection
      
        '選択範囲から、1個の [セル番地] を抜き出す
        セル番地 = 選択範囲.Address(False, False)
        
        '2列目の最終行に追加
        Cells(Rows.Count, 2).End(xlUp).Offset(1, 0).Value = Range(セル番地).Value

    Next 選択範囲


End Sub

②複数選択したセルを、セル内に追加するコード

Sub 選択セルの値_特定セル内に追加()
  
    Dim 選択範囲 As Range
    Dim セル番地 As String


    'セルが選択状態ではない場合はマクロ終了
    '例:図などのオブジェクトが選択状態で、セルが選択状態にない場合、など
    If TypeName(Selection) <> "Range" Then
        Exit Sub
    End If


    '選択範囲(Selection)を、変数 [範囲選択] に代入
    For Each 選択範囲 In Selection
      
        '選択範囲から、1個の [セル番地] を抜き出す
        セル番地 = 選択範囲.Address(False, False)

        If Range("G6").Value = "" Then
           '空欄ならば、そのまま追加
           Range("G6").Value = Range(セル番地).Value
        Else
           '既に記入されていれば、元セルの値に加える
           Range("G6").Value = Range("G6").Value & vbCrLf & Range(セル番地).Value
        End If

    Next 選択範囲


End Sub

解説

選択セルの [セル番地] を抜き出して、イミディエイトウィンドウで見てみます。

'選択範囲(Selection)を、変数 [範囲選択] に代入
For Each 選択範囲 In Selection
  
    '選択範囲から、1個の [セル番地] を抜き出す
    セル番地 = 選択範囲.Address(False, False)
    
    'デバック
    Debug.Print セル番地

Next 選択範囲

図のように、複数選択したセルの、[セル番地] が取り出せていますね。

最後に

いろいろ応用できますね。

・範囲で選択したセルの、書式設定を変更する
・セル番地の列を参照して、この列の場合はこの列に挿入

という場面も、この方式で解決します。

コメント

タイトルとURLをコピーしました