セル範囲の伸び縮みに追随して名前を定義する[Excel](2)
セル範囲の伸び縮みに追随して名前を定義するマクロの改良
改良ポイント
前回
のリスト１には問題があった。すなわち、
- 対象のセル範囲から値を全消去したら、名前の定義されたセル範囲が元のまま残る
- 対象のセル範囲（を含む範囲）を削除すると、参照切れになった名前だけが残る
というもの。
そもそもが、名前を付けた範囲にちょっと要素を付け足したり、要素を削除したり、ぐらいの使い方を想定していたので、ごっそり削除するなどということは考えていなかったわけですよ。
でもまあ、せっかくなので、対応を考えてみたというわけ。
修正後のコード
次のように修正した。
リスト１ 標準モジュール
Public Sub updateRangeName(ByVal Target As Range, _
ByVal targetColumn As Long, _
ByVal startRow As Long, _
ByVal targetName As String)
On Error Resume Next
If Target.Column <> targetColumn Then Exit Sub
Dim Sh As Worksheet
Set Sh = Target.Parent
Dim tmpRange As Range '……(1)'
Set tmpRange = Sh.Range(targetName) '……(2)'
If Err.Number = 0 Then '……(3)'
If Not hasAnyValue(tmpRange) Then _
tmpRange.Cells(1, 1).Name = targetName: Exit Sub '……(4)'
Else
Err.Clear '……(5)'
End If
On Error Goto 0
Dim maxRow As Long
maxRow = Sh.Cells(Rows.Count, targetColumn).End(xlUp).Row
If Target.Row < startRow Or startRow > maxRow Then '……(6)'
If Not hasReferences(targetName) Then _
Sh.Parent.Names(targetName).Delete: Exit Sub
End If
With Sh
.Range(.Cells(startRow, targetColumn), _
.Cells(maxRow, targetColumn)).Name = targetName
End With
End Sub
Private Function hasAnyValue(ByVal targetRange As Range) As Boolean '……(a)'
Dim targetCell As Range
For Each targetCell In targetRange
If targetCell.Value <> "" Then hasAnyValue = True: Exit Function
Next
hasAnyValue = False
End Function
Private Function hasReferences(ByVal NameOfRange As String) As Boolean '……(b)'
On Error Resume Next
Dim tmpRange As Range
Set tmpRange = Range(NameOfRange)
If Err.Number = 0 Then
hasReferences = True
Else
hasReferences = False
End If
Err.Clear
End Function
変更箇所を中心に。
まずは(1)からの８行（実質７行）
Dim tmpRange As Range
Set tmpRange = Sh.Range(targetName) '……(2)'
If Err.Number = 0 Then '……(3)'
If Not hasAnyValue(tmpRange) Then _
tmpRange.Cells(1, 1).Name = targetName: Exit Sub '……(4)'
Else
Err.Clear '……(5)'
End If
(2)の
Set tmpRange = Sh.Range(targetName)
で、Range型の変数tmpRangeにRange(targetName)をとりあえずぶち込んでみる。
もし、引数targetNameで受け取った名前が定義されていなければ、ここでエラーが出る。
そこで、(3)からの６行(実質５行）
If Err.Number = 0 Then
If Not hasAnyValue(tmpRange) Then _
tmpRange.Cells(1, 1).Name = targetName: Exit Sub '……(4)'
Else
Err.Clear '……(5)'
End If
で、エラーの有無（うむ/ゆうむ）によって分岐する。
エラーが出ていなかった場合、すなわちtargetNameで受け取った名前のセル範囲が存在するということだから、(4)の
If Not hasAnyValue(tmpRange) Then _ tmpRange.Cells(1, 1).Name = targetName: Exit Sub
に移る。
hasAnyValueというのは自作のFunction。リスト１の(a)がそれ。セル範囲（この場合はtargetNameで指し示されるセル範囲）を調べて値が入っているセルがあればTrue、全て空白ならFalseを返す。
targetNameで指し示されるセル範囲が空白、つまりセル範囲の値が全削除された場合にThen以下の
tmpRange.Cells(1, 1).Name = targetName: Exit Sub
を実行する。
定義されたセル範囲の値が全削除された場合は、先頭の１セルだけに名前を定義し直して処理を抜ける、ということになる。
エラーが出ていた場合、すなわちtargetNameで指し示されるセル範囲がない場合は、(5)の
Err.Clear
でErrオブジェクトをリセットして次へ進む。
あとは(6)からの４行（実質３行）
If Target.Row < startRow Or startRow > maxRow Then
If Not hasReferences(targetName) Then _
Sh.Parent.Names(targetName).Delete: Exit Sub
End If
行をまるごと削除するなどして、名前を定義していたセル範囲がなくなってしまったような場合には、
startRow > maxRow
がTrueになるので、Then以下の
If Not hasReferences(targetName) Then _ Sh.Parent.Names(targetName).Delete: Exit Sub
に処理が移る。
hasReferencesというのは、自作のFunction。リスト１の(b)がそれ。名前を渡したら、その名前がリンク切れになっているかどうかを調べ、リンクが生きていればTrue、リンクが切れていたらFalseを返す、というもの。
よって、リンクが切れていたら
Not hasReferences(targetName)
がTrueになり、
Sh.Parent.Names(targetName).Delete: Exit Sub
が実行される。リンク切れになった名前を削除し、処理を抜けることになる。
処理がここまでたどり着いている時点でtargetNameで渡された名前はブックに存在していることになるので、targetNameのチェックは必要ないと思う。
ざっと、こんな感じ。
実行結果
シートモジュールのコードは前回同様。
まず、この状態で、好漢たちの名前を全消去してみる。
名前が消えるとともに、もはやこのセル範囲の名前が「梁山泊」ではなくなっていることがお分かりだろう。
しかし、梁山泊はここに細々と生き残っているのであった。
分かりにくい画像ですまんが、今度は豪快に行ごと削除してやった。
[数式]タブから「名前の管理」を見てみると、
どうやら梁山泊は滅亡した模様。金に攻められたのだろうか……。
しかし！
１つでも名前を入れると、梁山泊復活！ 胸熱！
おわりに
本当にここまでする必要があったのだろうか、とは思うが、いろいろ勉強にはなった。
