| |
こんばんは。
>>>項目名のセルだけは残るように選択解除したいんです。
ＶＢＡでやるなら、
'=====================================================
Sub test()
Range("a1:g2000").Value = "aaaaa"
Set rng = rvsrng(Range("a1:g2000"), Range("A1,B5,F360,E240"))
rng.Value = ""
End Sub
'========================================================================
Function rvsrng(rng1 As Object, rng2 As Object, Optional osht As Boolean = False) As Range
'rng1のセル範囲の中でrng2以外のセル範囲を取得する
'input rng1,rng2---セル範囲
' osht --- false -対象シートはアクティブシート True---対象シートはアクティブシートではない
'output rvsrng:rng1のリバースのセル範囲
Const limlen = 255
Dim rng As Range
Dim add1 As String
Dim f_flg As Boolean
Set rvsrng = rng1
If Not Application.Intersect(rng1, rng2) Is Nothing Then
f_flg = False
Set rvsrng = Nothing
add1 = String(300, "a")
For Each rng In rng1
If Application.Intersect(rng, rng2) Is Nothing Then
If Len(add1 & "," & rng.Address(False, False, xlA1, osht)) > limlen Then
If f_flg = True Then
GoSub set_rng_to_rvsrng
Else
f_flg = True
End If
add1 = rng.Address(False, False, xlA1, osht)
Else
add1 = add1 & "," & rng.Address(False, False, xlA1, osht)
End If
End If
Next rng
GoSub set_rng_to_rvsrng
End If
Exit Function
set_rng_to_rvsrng:
'add1で示されるセル範囲をRvsrngに追加する
'in:add1 out:rvsrng
If Not rvsrng Is Nothing Then
With Application
Set rvsrng = .Union(rvsrng, .Range(add1))
End With
Else
Set rvsrng = Application.Range(add1)
End If
Return
End Function
これで出来ますが・・・。
>>全部消して、項目名だけもう一度書き込むとかじゃだめですか？
↑ここで言う「全部」にあたるセル範囲が広範囲で
「項目名」に当たるセル範囲が１０や２０なら、
上記のロジックの方が断然早いと思いますけどね！！
|
|
![[未読]](./data/excel/image/read_icon.gif){kind=icon}
