Results of 1 - 1 of about 37684 for IF (0.007 sec.)
- [[20211122065807]]
- #score: 1591
- @digest: ca34123b0a9bfb55447bd6fc96ef9b4b
- @id: 89675
- @mdate: 2021-11-26T00:02:35Z
- @size: 25147
- @type: text/plain
- #keywords: selectarea (95375), idrow (83469), seltopcol (66427), ア外 (56717), 択エ (44883), 力エ (43826), ア範 (38448), 分- (35357), areas (19895), vbokonly (18706), 定if (18035), エリ (12474), リア (12395), myrng (11586), 択セ (10478), 行範 (10033), rnglist (9657), 差分 (8849), 中止 (8811), parent (8123), 囲外 (7605), 個人 (7287), intersect (6964), union (6690), selection (6103), typename (6010), 選択 (5800), ル選 (5664), nothing (4837), cells (4479), 択範 (4450), クリ (4203)
- 『マクロで「飛び飛びセル選択に対応する指定行範囲クリア」』（マイン）
お世話になっております。 質問は マウスでセル連続選択・飛び飛びセル選択に対する値のクリアについてです。 ※クリアの条件:選択セルの位置する指定行範囲に対し値をクリア シート構成:帳票 ・個人のデータ入力範囲は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 ---- ponpon さん ありがとうございます。 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 ---- ★混乱するとよくないので一段落してからお読みください★ ■1 「Intersectメソッド」が理解できているのであれば、↓のような判定は避けたほうがよいと思います。 SelTopCol = SelectArea.Cells(1).Column If SelTopCol <= 29 Then ■2 解ってやっているなら別によいですが、基本的にマルチステートメントは避けた方がよいとおもいます。 （特に質問サイトで質問しているような段階なら基本形で書いた方が後々混乱しなくてよいと思います） ■3 ＞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 （もこな2） 2021/11/22(月) 19:35 ---- もこな2 さんありがとうございます。 アドバイスを参考に下記で希望通りの処理ができるようになりました。 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 ---- 数が多くないと、遅いとは思わない。 エリアで無く、セルの数が4000個とかでやってみては? 実際、PCも向上しているし、VBAの処理速度も向上しているし…、試してみないとよく解らない。 （にくちゃんねる） 2021/11/22(月) 21:19 ---- ■4 同時進行されると、混乱すると思ったので、最初に「一段落してからお読みください」と書いたつもりですが大丈夫ですか? ■5 もしも、比較するなら極力条件は合わせないと正しくないと思いますよ。 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 （もこな2） 2021/11/22(月) 21:22 ---- もこな2 さん 行範囲を求める方法について、アドバイスいただいた別案でやってみました。 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 ---- ■6 再三になりますが、同時進行されると混乱しませんか?本当に大丈夫ですか? ■7 ＞入力エリアか判定 そもそもの目的（必要性）がわかりませんが、【選択しているセル】に30行目未満が含まれているか判定したいのであれば「ActiveCell」を基準にするのは不適当でしょう。 ■8 c1 = r.Column c2 = c1 + Range(r.Address(0, 0)).Columns.Count - 1 '差分-1 ↑は↓でよくありませんか? c2 = c1 + r.Columns.Count - 1 '差分-1 ■9 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 強いて言えば、セル範囲ごとに、クリアしたい【列範囲】が異なるのでしょうか? （もこな2） 2021/11/23(火) 15:17 ---- ↑の訂正。 誤 【選択しているセル】に30行目未満が含まれているか 正 【選択しているセル】にAD列より前の列が含まれているか （もこな2） 2021/11/23(火) 18:49 ---- もこな2 さん 度重なるアドバイス感謝いたします。 ご質問と当方が何をしているのか、下記のとおりまとめてみました。 ■6 再三になりますが、同時進行されると混乱しませんか?本当に大丈夫ですか? →はい、Intesectについて学びを深めたいと考えておりますので感謝しております。 ■7 ＞入力エリアか判定 →確認したところご指摘の通り複数選択した場合に、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 ■8 c2 = c1 + Range(r.Address(0, 0)).Columns.Count - 1 '差分-1 →ご指摘のとおり、Range(r.Address(0, 0))は無駄で c2 = c1 + r.Columns.Count - 1 '差分-1 で連続選択したセルの最終列が取得できました。 ■9 ■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 ---- ■11 ＞Intesectについて学びを深めたい では↓を読まれるとよいと思います。 http://officetanaka.net/excel/vba/tips/tips118.htm https://excel-ubara.com/excelvba1/EXCELVBA402.html https://www.moug.net/tech/exvba/0050074.html ■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した範囲を処理しちゃだめですよね。（複数人分を処理することになってしまうので） （もこな2） 2021/11/23(火) 21:59 ---- ■14 ＞・個人単位…複数個人にまたがってセル選択した場合は、ActiveCellがある個人のみ処理する ↑の仕様で考えてみました。 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 ちょっと悩みましたが、二人目が来ちゃったときだけ、アクティブセルに依存すると考えればよさそうですね。 （もこな2） 2021/11/23(火) 23:36 ---- もこな2 さん ありがとうございます。 >"アクティブセル依存モードに移行します" なんか、カッコよくかつ、相手にわかりやすく良いですね。 仕事の合間見ながら確認したいと思います。 （マイン） 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... - https://www.excel.studio-kazu.jp/wiki/kazuwiki/202111/20211122065807.txt - [detail] - similar
PREV
NEXT
Powered by Hyper Estraier 1.4.13, with 97043 documents and 608212 words.
訪問者：