Excel VBA質問箱 IV

当質問箱は、有志のボランティア精神のおかげで成り立っています。
問題が解決したら、必ずお礼をしましょうね。
本サイトの基本方針をまとめました。こちらをご一読ください。

投稿種別の選択が必要です。ご注意ください。
迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。


	新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃過去ログ ┃ホーム

48297 / 76732

←次へ　｜　前へ→


	【33371】Re:選択範囲から一部解除

ichinose - 06/1/9(月) 20:58 -


	引用なし

	パスワード

こんばんは。

>>>項目名のセルだけは残るように選択解除したいんです。
ＶＢＡでやるなら、
'=====================================================
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

これで出来ますが・・・。

>>全部消して、項目名だけもう一度書き込むとかじゃだめですか？

↑ここで言う「全部」にあたるセル範囲が広範囲で
「項目名」に当たるセル範囲が１０や２０なら、
上記のロジックの方が断然早いと思いますけどね！！

0 hits

▼

【33336】選択範囲から一部解除 サザエ 06/1/9(月) 15:42