エクセルのマクロで範囲名設定の記述を教えてください。

Question

エクセルのマクロで範囲名設定の記述を教えてください。

Lotus123時代に作成したマクロを、エクセルに置き換えるのに苦労しています。

範囲名ということで、特定のセル（範囲）に名称をつける機能がありますが
「カーソルの現在位置に範囲名をつける」方法がわかりません。
自動記録で作成すると、範囲名のセルに絶対値が入ってしまい、
これを繰り返し記述すると、次の範囲名のセルもまた同じ場所になってしまいます。
たとえばカーソルを置いたスタート位置にいったんセル名（範囲名）をつけ、
作業後にジャンプでその位置に戻り、そのセル名を削除した後、
ひとつ右にうつった位置を次の戻り位置として再指定することを繰り返したいのです。
Lotusでは行ってきたのですがエクセルではなかなかうまく行きません。

ActiveWorkbook.Names.Add Name:="範囲名",RefersToR1C1:="=Sheet1!R11C5: R13C5 "
作業後ジャンプでこの範囲セルに戻り、このセル名を削除
カーソルを別の位置に動かして、そこに新しく同じ名前のセル名をつくる。
このときの記述をどう書くかということです。
「Sheet1!R11C5: R13C5」というのが常にカーソルを置いた位置に可変させたいのです。

エクセル初心者をよろしくお願いいたします。

xls88 · Accepted Answer

実操作を「新しいマクロの記録」すれば参考コードが得られます。
記録の開始
http://www.officepro.jp/excelmacro/rec/index1.html

ファイルを選択する部分は下記ページを参考にしてください。
[ファイルを開く]ダイアログのフィルタリング
http://www.officetanaka.net/excel/vba/tips/tips109.htm

＞便乗してしまってすみません。
お分かりのように新規で質問される内容です。
上手くいかなければ新規質問をなさってください。

本稿の問題点はクリアされましたか？
クリアされたなら締め切り処理をお願いします。
クリアされていないなら遠慮なく追加質問してください。

xls88 · Answer

外しているかもしれませんが

＞たとえばカーソルを置いたスタート位置にいったんセル名（範囲名）をつけ
    Dim newlcl As String
    
    newlcl = "=" & ActiveSheet.Name & "!" & ActiveCell.Resize(3, 1).Address
    ActiveWorkbook.Names.Add Name:="範囲名", RefersTo:=newlcl

あるいは
    Dim newlcl As String
    
    newlcl = "=" & ActiveSheet.Name & "!" & Selection.Address
    ActiveWorkbook.Names.Add Name:="範囲名", RefersTo:=newlcl
ということでしょうか。

＞作業後にジャンプでその位置に戻り、そのセル名を削除した後、
＞ひとつ右にうつった位置を次の戻り位置として再指定することを繰り返したいのです。
削除ではなく変更の例です。
A1形式でやってみました。
≪ひとつ横にずらす例≫
    Dim newrflcl As String
    
    Application.Goto Reference:="範囲名"
    newrflcl = "=" & ActiveSheet.Name & "!" & Selection.Offset(, 1).Address
    ActiveWorkbook.Names("範囲名").RefersTo = newrflcl

≪もう一例≫
    Dim rflcl As String
    Dim rfrng As String
    Dim newlcl As String
    Dim newrng As String
    
    Application.Goto Reference:="範囲名"
    rflcl = ActiveWorkbook.Names("範囲名").RefersToLocal
    rfrng = Split(rflcl, "!")(1)
    newrng = Range(rfrng).Offset(, 1).Address
    newlcl = Replace(rflcl, rfrng, newrng)
    
    ActiveWorkbook.Names("範囲名").RefersTo = newlcl

＞「Sheet1!R11C5: R13C5」というのが常にカーソルを置いた位置に可変させたいのです。
    Dim rflcl As String
    Dim newlcl As String
    Dim rfrng As String
    Dim newrng As String
    Dim rer As Long
    Dim rec As Long
    
    rflcl = ActiveWorkbook.Names("範囲名").RefersToLocal
    rfrng = Split(rflcl, "!")(1)
    rer = Range(rfrng).Rows.Count
    rec = Range(rfrng).Columns.Count
    newrng = ActiveCell.Resize(rer, rec).Address
    newlcl = Replace(rflcl, rfrng, newrng)
    
    ActiveWorkbook.Names("範囲名").RefersTo = newlcl

xls88 · Answer

おぼろげですが、やっていることが見えてきました。
とりあえず、提示されたコードを纏めてみましたがどうでしょうか。

    Dim newlcl As String
    Dim i As Integer
    
    Range("AA1:AA500").ClearContents
    '/名前定義
    newlcl = "=" & ActiveSheet.Name & "!" & ActiveCell.End(xlDown).Address
    ActiveWorkbook.Names.Add Name:="start3", RefersTo:=newlcl
    '/コピー&貼り付け
    Range("start3").Copy
    Range("COPYDATA").PasteSpecial _
        Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
    '/コピー&貼り付けループ処理
    For i = 1 To 4
        'ループごとに"start3"からi列オフセットした範囲をCopy
        Range("start3", Range("start3").End(xlDown)).Offset(, i).Copy
        '値で貼り付け
        Range("COPYDATA").End(xlDown).Offset(1, 0).PasteSpecial _
            Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
    Next i
    '/コピーモード解除
    Application.CutCopyMode = xlCopy

上記のようなことなら、名前の定義を使わなくても出来ると思います。
定義名"start3"と"COPYDATA"は同一シートにあるのですか？
例えば下記のコードですが、
元のデータを、列単位で、AA1以下1列に、値で転記します。

    Dim rng As Range    'データセル範囲
    Dim c As Integer    'rngの列数
    Dim r As Integer    'rngの行数
    Dim i As Integer    'ループカウンター
    
    Range("AA1:AA500").ClearContents
    
    Set rng = ActiveCell.CurrentRegion
    MsgBox rng.Address 'データセル範囲の確認
    c = rng.Columns.Count
    r = rng.Rows.Count
    For i = 0 To c - 1
        Range("AA1").Resize(r).Offset(i * r).Value = rng.Columns(i + 1).Value
    Next i
    Set rng = Nothing

xls88 · Answer

＞どこかでわかるのでしょうか。
最初の書き込みの内容がメールで届いていました。

＞回答番号：No.2 この回答への補足
上記で解ったことをコードに反映してみました。
定義名"COPYDATA"は、貼り付け先の先頭セルと解しています。

    Dim adre As String
    Dim lcl As String
    Dim newlcl As String
    Dim i As Integer
    Dim x As Integer
    
    Range("AA1:AA500").ClearContents
    
    '//名前の定義
    adre = Range(Selection, Selection.End(xlDown)).Address
    lcl = "=" & ActiveSheet.Name & "!" & adre
    ActiveWorkbook.Names.Add Name:="start3", RefersTo:=lcl
    
    '//コピー&貼り付けループ処理
    For i = 1 To 6
        '/コピー&貼り付け
        Range("start3").Copy
        If i = 1 Then
            Range("COPYDATA").PasteSpecial _
                Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
        Else
            Range("COPYDATA").End(xlDown).Offset(1, 0).PasteSpecial _
                Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
        End If
        '/移動量
        Select Case i
            Case 4: x = -2
            Case 5: x = 1
            Case Else: x = -1
        End Select
        '/名前の定義設定変更
        newlcl = "=" & ActiveSheet.Name & "!" & Range("start3").Offset(, x).Address
        ActiveWorkbook.Names("start3").RefersTo = newlcl
    Next i
    
    '//転記データをコピー
    Range("COPYDATA", Range("COPYDATA").End(xlDown)).Copy
    '//名前の定義セル範囲へジャンプ
    Application.Goto Reference:="start3"

下記でも同じ結果が得られると思います。

    Dim rng As Range    'データセル範囲
    Dim c As Integer    'rngの列数
    Dim r As Integer    'rngの行数
    Dim i As Integer    'ループカウンター
    Dim x As Integer    'オフセット量
    
    Range("AA1:AA500").ClearContents
    
    Set rng = ActiveCell.CurrentRegion
    c = rng.Columns.Count
    r = rng.Rows.Count
    For i = 0 To c - 1
        Select Case i
            Case c - 2: x = c - 1
            Case c - 1: x = c - 2
            Case Else: x = i
        End Select
        Range("AA1").Resize(r).Offset(i * r).Value = rng.Columns(c - x).Value
    Next i
    Range("AA1", Range("AA1").End(xlDown)).Copy
    Set rng = Nothing

xls88 · Answer

＞スタート位置(F列１行目）にカーソルを戻したい
定義名の設定を変更しないようにしてみました。

    Dim adre As String
    Dim lcl As String
    Dim rng As Range
    Dim i As Integer
    Dim x As Integer
    Dim n As Integer
    
    '//F列でなければ実行しない
    If ActiveCell.Column <> 6 Then Exit Sub
    '//コピー元列数取得
    n = Range(Selection, Selection.End(xlToLeft)).Columns.Count
    '//貼り付け先データ消去
    Range("AA1:AA500").ClearContents
    
    '//名前を定義
    adre = ActiveCell.Address
    lcl = "=" & ActiveSheet.Name & "!" & adre
    ActiveWorkbook.Names.Add Name:="start3", RefersTo:=lcl
    
    '//データを転記
    For i = 0 To n - 1
        '//コピー
        Select Case i
            Case n - 2: x = n - 1
            Case n - 1: x = n - 2
            Case Else: x = i
        End Select
        Range("start3", Range("start3").End(xlDown)).Offset(, -x).Copy
        '//貼り付け
        Select Case i
            Case 0: Set rng = Range("COPYDATA")
            Case Else: Set rng = Range("COPYDATA").End(xlDown).Offset(1, 0)
        End Select
        rng.PasteSpecial Paste:=xlPasteValues, _
            Operation:=xlNone, SkipBlanks:=False, Transpose:=False
    Next i
    
    '//転記データをコピー
    Range("COPYDATA", Range("COPYDATA").End(xlDown)).Copy
    '//名前定義セルを選択
    'Application.Goto Reference:="start3"
    Range("start3").Select
    
    Set rng = Nothing

＞範囲は列内は同じですが、グループごとに20～30行その都度異なる
グループとは、各列単位という認識で良かったですか？

＞最後のクリップボードの内容がAA1から最下段まで全部(すなわちA～Fまで）
＞の場合と、最後の範囲であるFだけしか残らない場合とがあって
下記で転記データをコピーしています。
Range("COPYDATA", Range("COPYDATA").End(xlDown)).Copy
従って、"COPYDATA"がAA1固定なら問題ないはずです。
ただし、セルをコピーしています。Escキー押し下げ等で、コピーモードが解除されると、クリップボードが空になります。

＞列とか行の指定をあらかじめする必要があるのでしょうか？
Set rng = ActiveCell.CurrentRegion
上記で、データセル範囲内を取得しようとしています。
データセル範囲内の、セルが選択されていれば、空白セルで囲まれた矩形範囲が取得されます。
データセル範囲が空白セルで囲まれていない場合、不要なセル範囲も含まれるので使えません。

xls88 · Answer

回答番号：No.4に追記です。
A列～F列で、各列毎に行数が異なる、ということなら
Range("start3", Range("start3").End(xlDown)).Offset(, -x).Copy
を
Range(Range("start3").Offset(, -x), Range("start3").Offset(, -x).End(xlDown)).Copy
と変更してください。

≪定義名を使わない例≫です。
    Dim adre As String
    Dim lcl As String
    Dim rngs As Range
    Dim rngc As Range
    Dim rngp As Range
    Dim i As Integer
    Dim x As Integer
    Dim n As Integer
    
    '//F列でなければ実行しない
    If ActiveCell.Column <> 6 Then Exit Sub
    '//貼り付け先データ消去
    Range("AA1:AA500").ClearContents
    '//開始セル
    Set rngs = ActiveCell
    '//コピー元列数取得
    n = Range(rngs, rngs.End(xlToLeft)).Columns.Count
    
    '//データを転記
    For i = 0 To n - 1
        '//コピー元
        Select Case i
            Case n - 2: x = n - 1
            Case n - 1: x = n - 2
            Case Else: x = i
        End Select
        Set rngc = Range(rngs.Offset(, -x), rngs.Offset(, -x).End(xlDown))
        '//貼り付け先
        Select Case i
            Case 0: Set rngp = Range("AA1")
            Case Else: Set rngp = Range("AA1").End(xlDown).Offset(1)
        End Select
        '//値貼り付け
        rngp.Resize(rngc.Rows.Count, rngc.Columns.Count).Value = rngc.Value
    Next i
    
    '//転記データをコピー
    Range("AA1", Range("AA1").End(xlDown)).Copy
    
    Set rngs = Nothing: Set rngc = Nothing: Set rngp = Nothing

xls88 · Answer

＞どちらも、選択範囲グループでなく最終グループのデータがCOPYDATAに入り、
＞あわせてクリップボードにはまったく関係ない直前のクリップボードが残っていました。
表現が曖昧です。
クリップボードとはWindowsのクリップボードのことですね？
COPYDATAの定義はどうなっていますか？

コードを実行した時、アクティブセルのあるデータ範囲グループのデータがAA列でAA1以下に入るようになっています。
つまり、COPYDATAセル範囲には、選択範囲グループのデータが入っているはずです。
そして、COPYDATAのセル範囲をCopyしています。クリップボードにはこのデータが入っているはずです。
Ctrl＋V で貼り付けてみてください。
ただし、先にも書きましたが、Excelのコピーモードが解除されるとクリップボードの内容は空になります。

＞に関数を使ったデータが埋まっています。
＞21行目から25行目までもエラー関数で埋まっていますが
＞グループごとにしわけるため
＞21行目(A～F）はセル内容を削除し空白セルとなっています。
G列は空白ではないのですか？
列はA～Fで固定ということですか？

＞各データをグループごとにつくり、その都度テキストデータに張り付けています。
テキストファイルに貼り付けているという事ですか？
レベルが上がりますが、VBAでテキストファイルに書き込むことも可能です。
クリップボードに、直接データを格納することも可能です。

＞スタート位置はグループごとの行数が不規則なので手動でカーソルをおきセルを特定してます）
ということなら、作業開始セルに戻る必要性はないと思いますが、どうでしょうか？

xls88 · Answer

＞第１グループのデータ集約（F１からのスタート）をしたらCOPYDATAには第４グループのデータが入っていたということです。
全く同じ環境を用意できないので確認ができません。
少なくとも当方のテスト環境では無問題です。
念のためにお聞きしますが、
手動（あるいは別のプログラム）でコピー操作をしているというようなことはないですか？

エラー値表示セルとデータ表示セルは矩形範囲で固まっているのですか？

試しにクリップボードに入れてみました。
noro6857さんのコードからは離れますが試してみてください。
これまで、徐々に解ったことを反映しているつもりです。
各グループの先頭行なら、どの列のセルを選択していても、動くようにしています。
事前に、VBEの、ツールメニュー＞参照設定で
Microsoft Forms 2.0 Object Libraryにチェック入れてOK
で参照設定をする必要があります。
クリップボードを操作する(1)
http://www.officetanaka.net/excel/vba/tips/tips20.htm

    Dim buf As String, buf2 As String, CB As New DataObject
    Dim rng As Range    'データセル範囲
    Dim c As Range      'データセル
    Dim n As Integer    'データセル範囲の列数
    Dim i As Integer    'ループカウンター
    Dim x As Integer    'オフセット量

    '//選択セルが対象列範囲外なら中止
    If Intersect(ActiveCell, Columns("A:F")) Is Nothing Then Exit Sub
    '//旧抽出データ消去
    Range("AA1:AA500").ClearContents
    '//データ表示数式セル範囲の取得（エラー表示セルは除外）
    Set rng = Range("A" & ActiveCell.Row, "F" & ActiveCell.End(xlDown).Row)
    Set rng = rng.SpecialCells(xlCellTypeFormulas, 7)
    n = rng.Columns.Count
    '//データ抽出
    For i = n To 1 Step -1
        Select Case i
            Case 2: x = 1
            Case 1: x = 2
            Case Else: x = i
        End Select
        For Each c In Range(rng.Columns(x).Address)
            buf = buf & vbCrLf & c.Value
        Next
    Next i
    buf = Replace(buf, vbCrLf, "", 1, 1)
    '//クリップボードに格納
    With CB
        .SetText buf
        .PutInClipboard
        .GetFromClipboard
    End With
    '//データ貼り付け（確認用）
    ActiveSheet.Paste Destination:=Range("AA1")
    Set rng = Nothing

xls88 · Answer

≪アクティブセルのセル範囲を取得する一例≫
Areasプロパティを使います。
処理対象グループ内の、適当なデータ表示セルを選択して置いて、実行してください。

    Dim rng As Range
    Dim rnga As Range
    Dim a As Range
    
    '//選択セルが、A～F列以外なら実行を中止
    If Intersect(ActiveCell, Columns("A:F")) Is Nothing Then Exit Sub
    '//選択セルが、エラーなら実行を中止
    If IsError(ActiveCell) Then Exit Sub
    '//選択セルが、空白なら実行を中止
    If ActiveCell.Value = "" Then Exit Sub
    
    '//対象セル範囲
    Set rng = Range("A1", Range("F" & Rows.Count).End(xlUp))
    
    '//対象セル範囲内の数式セル範囲（エラー値セル、空白セル除外）
    Set rng = rng.SpecialCells(xlCellTypeFormulas, 7)
    
    '//処理対象セル範囲（アクティブセルがあるエリア）
    For Each a In rng.Areas
        If Not Intersect(ActiveCell, a) Is Nothing Then
            Set rnga = a
            Exit For
        End If
    Next
    MsgBox rnga.Address
    
    Set rng = Nothing: Set rnga = Nothing

≪テキストファイルに書き込む方法≫
下記ページの「テキストファイルに書き出す・読み込む」で紹介されています。
マクロの裏技
http://www.winboys.net/howtoxls/xlsfnk4.htm

エクセルのマクロで範囲名設定の記述を教えてください。

外しているかもしれませんが

おぼろげですが、やっていることが見えてきました。

この回答への補足

＞どこかでわかるのでしょうか。

この回答への補足

＞スタート位置(F列１行目）にカーソルを戻したい

回答番号：No.4に追記です。

＞どちらも、選択範囲グループでなく最終グループのデータがCOPYDATAに入り、

この回答への補足

＞第１グループのデータ集約（F１からのスタート）をしたらCOPYDATAには第４グループのデータが入っていたということです。

この回答への補足

≪アクティブセルのセル範囲を取得する一例≫

実操作を「新しいマクロの記録」すれば参考コードが得られます。

似たような質問が見つかりました

関連するカテゴリからQ&Aを探す

デイリーランキングこのカテゴリの人気デイリーQ&Aランキング

マンスリーランキングこのカテゴリの人気マンスリーQ&Aランキング