[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]
『マクロで「飛び飛びセル選択に対応する指定行範囲クリア」』（マイン）
お世話になっております。
質問は
マウスでセル連続選択・飛び飛びセル選択に対する値のクリアについてです。
※クリアの条件：選択セルの位置する指定行範囲に対し値をクリア
シート構成:帳票
・個人のデータ入力範囲は8行あり表内に複数の個人が8行毎に登録
現在のコード
マウスで任意のセルを「連続選択」すると個人の行範囲をクリアする
ところまで作成できました。
このコードに
Ctl+クリックで「飛び飛びセル選択」に対しても同様にクリア
できるよう機能追加したいと考えております。
皆様何卒アドバイスのほどよろしくお願いいたします。
Sub 選択エリアで個人範囲クリア()
'▼選択セルの行列番号取得
Dim SelectArea As Range: Set SelectArea = Selection '1選択セル範囲取得
Dim SelTopCol As Long: SelTopCol = SelectArea.Cells(1).Column '2先頭列
Dim SelMaxCol As Long: SelMaxCol = SelectArea.Cells(SelectArea.Count).Column '3最終列
Dim r As Long, c As Long, IDrow As Long
With ActiveSheet
'▼選択禁止
If SelTopCol <= 29 Then MsgBox "項目は選択できません", vbOKOnly, "中止": Exit Sub
'▼ID行の特定
r = Cells(Rows.Count, 6).End(xlUp).row - 7'最終行
c = 62'最終列
For IDrow = 4 To r Step 8'セル位置からID行=クリアする先頭行を特定
If Not Application.Intersect(ActiveCell, Range(Cells(IDrow, 30), Cells(IDrow + 7, c))) Is Nothing Then Exit For
Next IDrow
'▼個人エリア消去
Application.ScreenUpdating = False
.Range(.Cells(IDrow, SelTopCol), .Cells(IDrow + 7, SelMaxCol)).Value = ""
Application.ScreenUpdating = True
End With
End Sub
＜ 使用 Excel：Excel2019、使用 OS：Windows10 ＞
Dim SelectArea As Range: Set SelectArea = Selection '1選択セル範囲取得
Dim SelTopCol As Long: SelTopCol = SelectArea.Cells(1).Column '2選択セルの先頭列
Dim SelMaxCol As Long: SelMaxCol = SelectArea.Cells(SelectArea.Count).Column '3選択セルの最終列
（マイン） 2021/11/22(月) 07:14
Sub test()
Dim rng As Range
For Each rng In Selection
Debug.Print rng.Row
' .Range(.Cells(rng.row, SelTopCol), .Cells(rng.row, SelMaxCol)).Value = ""
Next
End Sub
これで選択範囲の全ての行番号が分かります。 （ponpon） 2021/11/22(月) 08:10
以下のサンプルを実行してみてください。 それぞれ、For Each NextでのRangeオブジェクトのアドレスを イミディエイトウィンドウに出力します。 その内容でロジックを組み直してみては。
Sub sample()
Debug.Print Selection.Address(0, 0)
Dim r As Range
For Each r In Selection
Debug.Print r.Address(0, 0)
Next
For Each r In Selection.Areas
Debug.Print r.Address(0, 0)
Next
End Sub
（tkit） 2021/11/22(月) 08:15
tkit さんの方法で
それぞれの選択範囲の先頭列・最終列を取得してみました。
Sub sample()
Dim r As Range
Dim c1 As Long, c2 As Long
For Each r In Selection.Areas
c1 = r.Column
c2 = c1 + Range(r.Address(0, 0)).Columns.Count - 1
Debug.Print c1 & "〜" & c2
Next
End Sub
あとは、選択範囲をクリアできるか試し
UNIONで一括で消去できるかもためしてみたいと思います。
またご報告いたします。
（マイン） 2021/11/22(月) 09:20
こういうのが知りたい？
MsgBox SelectArea.Areas(1).Cells(1).Column
With SelectArea.Areas(SelectArea.Areas.Count)
MsgBox .Cells(.Cells.Count).Column
End With
（にくちゃんねる） 2021/11/22(月) 09:28
★混乱するとよくないので一段落してからお読みください★
■１
「Intersectメソッド」が理解できているのであれば、↓のような判定は避けたほうがよいと思います。
SelTopCol = SelectArea.Cells(1).Column If SelTopCol <= 29 Then
■２
解ってやっているなら別によいですが、基本的にマルチステートメントは避けた方がよいとおもいます。
（特に質問サイトで質問しているような段階なら基本形で書いた方が後々混乱しなくてよいと思います）
■３
＞UNIONで一括で消去できるかもためしてみたいと思います。
↑のようにコメントされているので、半ば気づいていらっしゃるようですが、こういうアプローチもあったとおもいます。
Sub 別案()
Dim i As Long
Dim MyRNG As Range
If TypeName(Selection) <> "Range" Then
MsgBox "セル以外が選択されているので処理を中止します"
Else
With Selection
For i = 0 To (.Areas(.Areas.Count).Cells(.Areas(.Areas.Count).Cells.Count).Row - 4) \ 8 Step 1
If Not Intersect(.EntireRow, .Parent.Range("AD4:BJ11").Offset(i * 8)) Is Nothing Then
If MyRNG Is Nothing Then
Set MyRNG = .Parent.Range("AD4:BJ11").Offset(i * 8)
Else
Set MyRNG = Union(MyRNG, .Parent.Range("AD4:BJ11").Offset(i * 8))
End If
End If
Next i
End With
End If
If Not MyRNG Is Nothing Then
MyRNG.Select 'これがClearContentsされればよい
End If
End Sub
（もこな２） 2021/11/22(月) 19:35
アドバイスを参考に下記で希望通りの処理ができるようになりました。
Sub テスト3()
Dim r As Long, IDrow As Long
With ActiveSheet
'▼選択禁止
If Selection.Column <= 29 Then MsgBox "項目列は選択できません", vbOKOnly, "中止": Exit Sub
'▼ID行の特定
r = Cells(Rows.Count, 6).End(xlUp).Row - 7
For IDrow = 4 To r Step 8
If Not Application.Intersect(ActiveCell, Range(Cells(IDrow, 30), Cells(IDrow + 7, 62))) Is Nothing Then Exit For
Next IDrow
'▼選択列の特定
Dim rng As Range, c1 As Long, c2 As Long, MyRNG As Range
For Each rng In Selection.Areas
'c1=選択先頭列 c2=選択最終列
c1 = rng.Column
c2 = c1 + Range(rng.Address(0, 0)).Columns.Count - 1 '差分-1
'選択範囲ごとにUnionに格納
If MyRNG Is Nothing Then
Set MyRNG = .Range(.Cells(IDrow, c1), .Cells(IDrow + 7, c2))
Else
Set MyRNG = Union(MyRNG, .Range(.Cells(IDrow, c1), .Cells(IDrow + 7, c2)))
End If
Next
'▼個人エリア消去
Application.ScreenUpdating = False
If Not MyRNG Is Nothing Then
MyRNG.Select '.ClearContents
End If
Application.ScreenUpdating = True
End With
End Sub
（マイン） 2021/11/22(月) 20:06
UNIONは遅いと聞きますので実際どうなのか
実際のデータを使用してUNION「使用」「未使用」とで比較してみました。
(UNION未使用)※ループ内で都度クリアする方法
For Each rng In Selection.Areas
c1 = rng.Column
c2 = c1 + Range(rng.Address(0, 0)).Columns.Count - 1 '差分-1
.Range(.Cells(IDrow, c1), .Cells(IDrow + 7, c2)).Value = "" '選択範囲ごとにクリア
Next
UNION
0.015625 0.0234375 0.015625 0.015625 0.0078125 0.015625
都度クリア
0.0390625 0.046875 0.046875 0.0390625 0.0390625 0.046875
（マイン） 2021/11/22(月) 20:39
■５
もしも、比較するなら極力条件は合わせないと正しくないと思いますよ。
Sub 別案_別々版()
Dim i As Long
If TypeName(Selection) <> "Range" Then
MsgBox "セル以外が選択されているので処理を中止します"
Else
With Selection
For i = 0 To (.Areas(.Areas.Count).Cells(.Areas(.Areas.Count).Cells.Count).Row - 4) \ 8 Step 1
If Not Intersect(.EntireRow, .Parent.Range("AD4:BJ11").Offset(i * 8)) Is Nothing Then
Parent.Range("AD4:BJ11").Offset(i * 8).ClearContents
End If
Next i
End With
End If
End Sub
（もこな２） 2021/11/22(月) 21:22
行範囲を求める方法について、アドバイスいただいた別案でやってみました。
Sub テスト5()
'入力エリアか判定
If Intersect(ActiveCell, Range(Cells(4, 30), Cells(Cells(Rows.Count, 6).End(xlUp).Row, 62))) Is Nothing Then
MsgBox "入力エリア外です", vbCritical + vbOKOnly, "範囲外"
Exit Sub
End If
Dim r As Range, c1 As Long, c2 As Long
Dim i As Long, MyRNG As Range
'セルを選択しているか判定
If TypeName(Selection) <> "Range" Then
MsgBox "セル以外が選択されているので処理を中止します"
Else
With Selection
For i = 0 To (.Areas(.Areas.Count).Cells(.Areas(.Areas.Count).Cells.Count).Row - 4) \ 8 Step 1 'どの行範囲か特定
If Not Intersect(.EntireRow, .Parent.Range("AD4:BJ11").Offset(i * 8)) Is Nothing Then
For Each r In .Areas
'c1=選択先頭列 c2=選択最終列
c1 = r.Column
c2 = c1 + Range(r.Address(0, 0)).Columns.Count - 1 '差分-1
'選択範囲ごとにUnionに格納
If MyRNG Is Nothing Then
Set MyRNG = .Parent.Range(Cells(4, c1), Cells(11, c2)).Offset(i * 8)
Else
Set MyRNG = Union(MyRNG, .Parent.Range(Cells(4, c1), Cells(11, c2)).Offset(i * 8))
End If
Next r
End If
Next i
End With
End If
If Not MyRNG Is Nothing Then
Application.ScreenUpdating = False
MyRNG.ClearContents 'これがClearContentsされればよい
Application.ScreenUpdating = True
End If
End Sub
（マイン） 2021/11/23(火) 08:21
■７
＞入力エリアか判定
そもそもの目的（必要性）がわかりませんが、【選択しているセル】に30行目未満が含まれているか判定したいのであれば「ActiveCell」を基準にするのは不適当でしょう。
■８
c1 = r.Column c2 = c1 + Range(r.Address(0, 0)).Columns.Count - 1 '差分-1
↑は↓でよくありませんか？
c2 = c1 + r.Columns.Count - 1 '差分-1
■９
c1 = r.Column c2 = c1 + Range(r.Address(0, 0)).Columns.Count - 1 '差分-1 Set MyRNG = .Parent.Range(Cells(4, c1), Cells(11, c2)).Offset(0 * 8)
↑も↓でよくありませんか？
Set MyRNG = Intersect(r.Parent.Rows("4:11"), r.EntireColumn)
■10
↓のループにはどのような狙いがあるのですか？
For Each r In .Areas
省略
Next r
強いて言えば、セル範囲ごとに、クリアしたい【列範囲】が異なるのでしょうか？
（もこな２） 2021/11/23(火) 15:17
誤 【選択しているセル】に30行目未満が含まれているか
正 【選択しているセル】にAD列より前の列が含まれているか
（もこな２） 2021/11/23(火) 18:49
度重なるアドバイス感謝いたします。
ご質問と当方が何をしているのか、下記のとおりまとめてみました。
■６
再三になりますが、同時進行されると混乱しませんか？本当に大丈夫ですか？
→はい、Intesectについて学びを深めたいと考えておりますので感謝しております。
■７
＞入力エリアか判定
→確認したところご指摘の通り複数選択した場合に、ActiveCell以外の部分を考慮していませんでした。
下記のように修正しました。
'入力エリアか判定
Dim rSel As Range, rChk As Range
Set rSel = Selection
Set rChk = Intersect(rSel, Range(Cells(4, 30), Cells(Cells(Rows.Count, 6).End(xlUp).Row, 62)))
If rChk Is Nothing Then '単一セルはみ出し
MsgBox "入力エリア外です", vbOKOnly, "範囲外"
Exit Sub
Else
If rChk.Count <> rSel.Count Then '複数セルの一部はみ出し
MsgBox "入力エリア外です", vbOKOnly, "一部が範囲外"
Exit Sub
End If
End If
Set rSel = Nothing
Set rChk = Nothing
■８
c2 = c1 + Range(r.Address(0, 0)).Columns.Count - 1 '差分-1
→ご指摘のとおり、Range(r.Address(0, 0))は無駄で
c2 = c1 + r.Columns.Count - 1 '差分-1 で連続選択したセルの最終列が取得できました。
■９ ■10
→説明不足で申し訳ございません。
処理は「セル範囲ごとにクリアする」ものを作成しております。
処理については ・個人単位…複数個人にまたがってセル選択した場合は、ActiveCellがある個人のみ処理する ・セル選択方法…「単一セル・連続選択セル・飛び飛び(Ctl+選択)」でも対応できる といったことを想定しております。
→アドバイスを頂いたコードを元にデバッグしながら下記のようにいたしました。
・個人単位…
個人エリアが特定したら「flg = True、Exit For」で抜けて
For i = 0 To (.Areas(.Areas.Count).Cells(.Areas(.Areas.Count).Cells.Count).Row - 4) \ 8 Step 1 'どの行範囲か特定 If Not Intersect(.EntireRow, .Parent.Range(Cells(4, 30), Cells(11, 62)).Offset(i * 8)) Is Nothing Then flg = True Exit For End If Next i
・セル選択方法…
選択セル範囲毎にUNIONに格納していく
If flg = True Then For Each r In .Areas 省略(セル範囲毎に選択セルを取得) Next r End If
・動作確認ができたコードは下記になります。
Sub 選択エリア範囲クリア()
'セルを選択しているか判定
If TypeName(Selection) <> "Range" Then
MsgBox "セル以外が選択されているので処理を中止します"
Exit Sub
End If
'入力エリアか判定
Dim rSel As Range, rChk As Range
Set rSel = Selection
Set rChk = Intersect(rSel, Range(Cells(4, 30), Cells(Cells(Rows.Count, 6).End(xlUp).Row, 62)))
If rChk Is Nothing Then '単一セルはみ出し
MsgBox "入力エリア外です", vbOKOnly, "範囲外"
Exit Sub
Else
If rChk.Count <> rSel.Count Then '複数セルの一部はみ出し
MsgBox "入力エリア外です", vbOKOnly, "一部が範囲外"
Exit Sub
End If
End If
Set rSel = Nothing
Set rChk = Nothing
'個人エリア特定
Dim r As Range, MyID As Variant
Dim i As Long, MyRNG As Range, flg As Boolean
With Selection
For i = 0 To (.Areas(.Areas.Count).Cells(.Areas(.Areas.Count).Cells.Count).Row - 4) \ 8 Step 1 'どの行範囲か特定
If Not Intersect(.EntireRow, .Parent.Range(Cells(4, 30), Cells(11, 62)).Offset(i * 8)) Is Nothing Then
flg = True 'アクティブセルがある8行おきにある個人領域のみを対象とする
Exit For
End If
Next i
If flg = True Then
For Each r In .Areas
If MyRNG Is Nothing Then 'Unionに選択範囲単位で格納
Set MyRNG = Intersect(r.Parent.Rows("4:11"), r.EntireColumn).Offset(i * 8)
Else
Set MyRNG = Union(MyRNG, Intersect(r.Parent.Rows("4:11"), r.EntireColumn).Offset(i * 8))
End If
Next r
End If
End With
'クリア
If Not MyRNG Is Nothing Then
Application.ScreenUpdating = False
MyRNG.Select 'ClearContents
Application.ScreenUpdating = True
End If
End Sub
（マイン） 2021/11/23(火) 19:49
■12
＞下記のように修正しました。
本人が納得できる方法が一番だと思いますが、私ならこうします。
Sub 実験01()
Dim bufRNG As Range
'セルを選択しているか判定
If TypeName(Selection) <> "Range" Then
MsgBox "セル以外が選択されているので処理を中止します"
Exit Sub
End If
Set bufRNG = Intersect(Selection, Range("A:AC"))
If bufRNG Is Nothing Then
MsgBox "AD列より前は選択されていません"
Else
If Selection.Address = bufRNG.Address Then
MsgBox "AD列より前しか選択されていません"
Else
MsgBox "選択されているセル範囲にAD列より前のセルが含まれています"
End If
End If
End Sub
要は、判定するにしても、SelectionがA〜AC列に入ってるかどうかを判定すれば十分じゃないかと。
■13
＞ ・個人単位…複数個人にまたがってセル選択した場合は、ActiveCellがある個人のみ処理する
なるほど。個人的には違和感がでる処理ですが、まぁそういうことが前提なら複雑化しますねぇ。
ただ、それならUnionした範囲を処理しちゃだめですよね。（複数人分を処理することになってしまうので）
（もこな２） 2021/11/23(火) 21:59
Sub 実験02()
Dim MyRNG As Range
Dim i As Long
'セルを選択しているか判定
If TypeName(Selection) <> "Range" Then
MsgBox "セル以外が選択されているので処理を中止します"
Exit Sub
End If
For i = 4 To ActiveSheet.Cells.SpecialCells(xlCellTypeLastCell).Row Step 8
If Not Intersect(Selection, ActiveSheet.Cells(i, "AD").Resize(8, 33)) Is Nothing Then
If MyRNG Is Nothing Then
Set MyRNG = ActiveSheet.Cells(i, "AD").Resize(8, 33)
Else
MsgBox "複数人が選択されています" & vbLf & "アクティブセル依存モードに移行します"
If ActiveCell.Row < 4 Then
MsgBox "アクティブセルが4行目未満のため処理を中止します"
Exit Sub
Else
Set MyRNG = ActiveSheet.Cells(ActiveCell.Row - ((ActiveCell.Row - 4) Mod 8), "AD").Resize(8, 33)
Exit For
End If
End If
End If
Next i
MsgBox MyRNG.Address(False, False) & " をクリアしてください"
End Sub
ちょっと悩みましたが、二人目が来ちゃったときだけ、アクティブセルに依存すると考えればよさそうですね。
（もこな２） 2021/11/23(火) 23:36
ありがとうございます。
"アクティブセル依存モードに移行します"
なんか、カッコよくかつ、相手にわかりやすく良いですね。
仕事の合間見ながら確認したいと思います。
（マイン） 2021/11/24(水) 09:31
>このコードに >Ctl+クリックで「飛び飛びセル選択」に対しても同様にクリア >できるよう機能追加したいと考えております。
このコードが出来れば、あとはそれを繰り返すだけなので、
このコードをまずはブラッシュアップしていきましょう。
Sub test()
Dim rngList As Range 'データセル範囲
Dim rngOperation As Range '操作対象セル範囲
Dim rngTarget As Range 'クリア対象セル範囲
Dim ix As Long
If TypeName(Selection) <> "Range" Then Exit Sub
With ActiveSheet
Set rngList = .Range(.Range("A4"), .Cells(.UsedRange.Count))
Set rngOperation = Intersect(rngList, .Range(.Columns("AC"), .Columns(.Columns.Count)))
End With
ix = (Selection.Row - rngList.Row + 1) \ 8 * 8
Set rngTarget = Intersect(rngOperation, ActiveSheet.Cells(ix, "AC").Resize(8).EntireRow)
rngTarget.Select
If MsgBox("OK?", vbYesNo) = vbYes Then rngTarget.ClearContents
End Sub
こんなことをやりたいのかなぁと書いてみましたが、
セルの位置関係がよくわからないので、うまく動作しないかもです。
シート上のイメージややりたいことを伝えてもらえるといいかもです。
もしかしたら、複数セル選択より、特定のセルダブルクリックで、
都度都度クリアして行けた方が使いやすいかなぁと思ったり。
（まっつわん） 2021/11/24(水) 09:43
> Set rngOperation = Intersect(rngList, .Range(.Columns("AC"), .Columns(.Columns.Count)))
Set rngOperation = application.Range(rnglist.Columns("AC"), rnglist.Columns(.Columns.Count)))
（まっつわん） 2021/11/24(水) 09:49
・特定のセルダブルクリック
→入力エリア内は
WorksheetChangeで「右クリックメニュー・ダブルクリック」のイベントを設定
しております。ですので・・・
セル選択・Ctrl+クリックで選択させて値をクリアするという方法をとっております。
（マイン） 2021/11/24(水) 10:04
特定のセルダブルクリックで、
都度都度クリアして行けた方が使いやすいかなぁと思ったり。
→現在作成しているコードはユーザーが
・入力データーのセル選択 ・UserFormのコマンドボタン実行(本コード) にてデータがクリアされるようにしております。 （マイン） 2021/11/24(水) 12:25
実務ファイルで動作確認が取れましたので下記の通り作成しました。
・同じような処理をするシートが複数あるため
「選択セルチェック」「クリア処理」を呼び出せるように作り直しました。
Sub 選択エリアで個人範囲クリア()
'セルを選択しているか判定
If TypeName(Selection) <> "Range" Then MsgBox "セル以外が選択されているので処理を中止します": Exit Sub
Dim Top_Row As Long, End_Row As Long, Top_Col As Long, End_Col As Long, Cnt_Step As Long, Cnt_Area As String, Cnt_Row As Long
Dim flg1 As Boolean, flg2 As Boolean
If ActiveSheet.Cells(1, 18).Value = "シートA" Then
'セル位置の設定
Top_Row = 20
End_Row = Cells(Rows.Count, 17).End(xlUp).Row
Top_Col = Format(DateSerial(Year(Cells(1, 23)), Month(Cells(1, 23)) + 1, 0), "d") + 23
End_Col = 180
Cnt_Step = 6
Cnt_Area = "20:25"
Cnt_Row = 25
'入力エリアを選択しているか判定(入力エリア外選択・一部はみ出し対応)
Call 選択エリア範囲_エリアチェク(Top_Row, End_Row, Top_Col, End_Col, flg1, flg2)
If flg1 = True Then MsgBox "入力エリア外です", vbOKOnly, "範囲外": Exit Sub 'セルはみ出し
If flg2 = True Then MsgBox "入力エリア外です", vbOKOnly, "一部が範囲外": Exit Sub '複数セルの一部はみ出し
'個人の選択(連続・飛び飛び選択対応)セルデータ入力範囲をクリア
Call 選択エリア範囲_クリア(Top_Row, End_Row, Top_Col, End_Col, Cnt_Step, Cnt_Area, Cnt_Row)
ElseIf ActiveSheet.name = "シートB" Then
Top_Row = 4
End_Row = Cells(Rows.Count, 6).End(xlUp).Row
Top_Col = 30
End_Col = 62
Cnt_Step = 8
Cnt_Area = "4:11"
Cnt_Row = 11
Call 選択エリア範囲_エリアチェク(Top_Row, End_Row, Top_Col, End_Col, flg1, flg2)
If flg1 = True Then MsgBox "入力エリア外です", vbOKOnly, "範囲外": Exit Sub
If flg2 = True Then MsgBox "入力エリア外です", vbOKOnly, "一部が範囲外": Exit Sub
Call 選択エリア範囲_クリア(Top_Row, End_Row, Top_Col, End_Col, Cnt_Step, Cnt_Area, Cnt_Row)
Else
MsgBox "このシートは処理対象外", vbOKOnly, "中止": Exit Sub
End If
End Sub
'入力エリアを選択しているか判定(入力エリア外選択・一部はみ出し対応)
Function 選択エリア範囲_エリアチェク(Top_Row As Long, End_Row As Long, Top_Col As Long, End_Col As Long, _
flg1 As Boolean, flg2 As Boolean)
Dim rngCHK As Range
Set rngCHK = Intersect(Selection, Range(Cells(Top_Row, Top_Col), Cells(End_Row, End_Col)))
If rngCHK Is Nothing Then
flg1 = True 'セルはみ出し
Else
If Selection.Address <> rngCHK.Address Then
flg2 = True '複数セルの一部はみ出し
End If
End If
Set rngCHK = Nothing
End Function
'個人の選択(連続・飛び飛び選択対応)セルデータ入力範囲をクリア
Function 選択エリア範囲_クリア(Top_Row As Long, End_Row As Long, _
Top_Col As Long, End_Col As Long, Cnt_Step As Long, Cnt_Area As String, Cnt_Row As Long)
'個人エリア特定
Dim i As Long, flg As Boolean ', MyID As Variant
With Selection
For i = 0 To (.Areas(.Areas.Count).Cells(.Areas(.Areas.Count).Cells.Count).Row - Top_Row) \ Cnt_Step Step 1 'どの行範囲か特定
If Not Intersect(.EntireRow, .Parent.Range(Cells(Top_Row, Top_Col), Cells(Cnt_Row, End_Col)).Offset(i * Cnt_Step)) Is Nothing Then
flg = True 'アクティブセルがある領域のみを対象とする
'MyID = .Parent.Cells(4, 9).Offset(i * 8) 'ID番号を取得
Exit For
End If
Next i
'Unionにそれぞれの選択範囲を格納
Dim r As Range, MyRNG As Range
If flg = True Then
For Each r In .Areas
If MyRNG Is Nothing Then
Set MyRNG = Intersect(r.Parent.Rows(Cnt_Area), r.EntireColumn).Offset(i * Cnt_Step)
Else
Set MyRNG = Union(MyRNG, Intersect(r.Parent.Rows(Cnt_Area), r.EntireColumn).Offset(i * Cnt_Step))
End If
Next r
End If
End With
'クリア
If Not MyRNG Is Nothing Then
Application.ScreenUpdating = False
MyRNG.ClearContents 'Select させてメッセージでクリアもあり
Application.ScreenUpdating = True
End If
End Function
（マイン） 2021/11/26(金) 09:02
[ 一覧(最新更新順) ]
YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki.
Modified by kazu.