Results of 1 - 1 of about 85 for VBA 強制終了 (0.004 sec.)
vba (14736), 強制終了 (237)
- [[20230217190936]]
- #score: 16175
- @digest: 33c27cff54baaac2beb781e27c64abbc
- @id: 93553
- @mdate: 2023-02-20T12:55:02Z
- @size: 10874
- @type: text/plain
- #keywords: 入挑 (53346), 戦") (42644), rngtarget (16201), xlnumbers (13747), 列. (13642), ルin (13393), ルen (11942), 四捨 (10356), 入() (10032), 捨五 (8949), 五入 (8761), ル. (8216), 列= (8141), 列as (5683), ルas (5361), 自宅 (5197), xlcelltypeconstants (4600), 列セ (4356), カラ (4193), numberformatlocal (4035), 挑戦 (3735), 列) (3592), entirecolumn (3043), ラス (2099), specialcells (2074), 理想 (1982), intersect (1815), 2023 (1807), モリ (1799), cells (1715), round (1685), worksheetfunction (1430)
- 『範囲外の列を選択してもエラーにならないようにしたいです』（カラス）
すみません。初心者ながらインターネットで調べて VBAをくっつけて試行錯誤しているものです。 M列からAK列までの範囲内でどの行やセルを選択しても実行すれば 14行目から113行目までの数値が0.00に四捨五入され書式設定も変わる というコードを目指して一応それを実行させる事が出来ました。 目指したい事は M列〜AK列以外の列を選択して実行しても ・その列には何も起こらない ・もしくは「範囲外です」などのメッセージが出てくれて何も起こらない に出来るコードを追加、ご教授頂けないでしょうか。 現状ではエラーが出てしまいます。 現状のコードは下記の様に作ってあります。 すみませんが宜しくお願い致します。 Sub 四捨五入() Sheets("四捨五入挑戦").Select Dim 列 As Range Dim セル As Range Set 列 = Selection.EntireColumn Set 列 = Intersect(Range("14:113"), 列) If WorksheetFunction.Count(gg) = 0 Then Exit Sub Set 列 = 列.SpecialCells(xlCellTypeConstants, xlNumbers) For Each セル In 列 セル = Round(セル, 2) セル.NumberFormatLocal = "0.00;-0.00;0" Next セル End Sub ＜ 使用 Excel:Microsoft365、使用 OS:Windows11 ＞ ---- すみません、誤記がありました。 こちらが自分の中の最新になります。 Sub 四捨五入() Sheets("四捨五入挑戦").Select Dim 列 As Range Dim セル As Range Set 列 = Selection.EntireColumn Set 列 = Intersect(Range("14:113"), 列) If WorksheetFunction.Count(列) = 0 Then Exit Sub Set 列 = 列.SpecialCells(xlCellTypeConstants, xlNumbers) For Each セル In 列 セル = Round(セル, 2) セル.NumberFormatLocal = "0.00;-0.00;0" Next セル End Sub （カラス） 2023/02/17(金) 19:28:56 ---- >M列〜AK列以外の列を選択して実行しても >・その列には何も起こらない >・もしくは「範囲外です」などのメッセージが出てくれて何も起こらない 参考程度ですが Sub test() Dim rng As Range, A As Range Set A = ActiveCell Set rng = Range("M:AK") If Intersect(A, rng) Is Nothing Then MsgBox "M列からAK列を選択してください。" Exit Sub End If End Sub （フォーキー） 2023/02/17(金) 19:47:20 ---- Sub 四捨五入() Sheets("四捨五入挑戦").Select Dim 列 As Range Dim セル As Range Set 列 = Selection.EntireColumn Set 列 = Intersect(Range("M14:AK113"), 列) 'Range("14:113") → Range("M14:AK113") '以下エラートラップ追加 If 列 Is Nothing Then MsgBox "Error 1" Exit Sub ElseIf WorksheetFunction.Count(列) = 0 Then MsgBox "Error 2" Exit Sub End If Set 列 = 列.SpecialCells(xlCellTypeConstants, xlNumbers) For Each セル In 列 セル.Value = Round(セル.Value2, 2) セル.NumberFormatLocal = "0.00;-0.00;0" Next セル End Sub 最低限の変更を加えました。 （ふなば） 2023/02/17(金) 19:48:32 ---- こうかな? 選択云々は意味が分からないけど、 「実行すると、四捨五入して書式を変える」 っていうところだけ実現するなら、配列使うといいと思う 数字以外もまぎれてるとエラーになるけど・・・ Sub 四捨五入() Dim w As Variant Dim 行 As Long, 列 As Long With Sheets("四捨五入挑戦").Range("M14:AK113") w = .Value For 行 = 1 To UBound(w, 1) For 列 = 1 To UBound(w, 2) w(行, 列) = Round(w(行, 列), 2) Next Next .Value = w .NumberFormatLocal = "0.00;-0.00;0" End With End Sub （稲葉） 2023/02/17(金) 19:55:05 ---- フォーキー様 ふなば様 稲葉様 本当にありがとうございます。目から鱗です。 色んなアプローチの仕方と挙動で どれも理想の動きをしてくれました。 本当に感謝いたします。初心者すぎてただ聞くだけではなく 頂いたコードを活用して基礎から学ぼうと思います。 改めまして本当にありがとうございます。 （カラス） 2023/02/17(金) 20:15:19 ---- すみません、マクロ以前の問題なのかもわかりません。 ここでふなば様から教えて頂いた下記のマクロの行数だけを変更して自宅のPCで何度やっても問題なく出来る事を確認し 自宅PCで作ったxlsを会社支給のUSBメモリ経由で会社PCで実行するとアクセシビティの利用不可?になり何度やっても無限ループのようになりタスクマネージャから強制終了しています。 処理量の問題なのか会社のセキュリティ?に引っかかっているのかわかりません。 また自宅で作った他のマクロについては動くものもあって どなたかご教授頂けないでしょうか。 フリーズするマクロ↓ Sub 四捨五入() Sheets("四捨五入挑戦").Select Dim 列 As Range Dim セル As Range Set 列 = Selection.EntireColumn '改良勉強する事! Set 列 = Intersect(Range("M14:AK9999"), 列) 'Range("14:9999") → Range("M14:AK9999") '以下エラートラップ追加 If 列 Is Nothing Then MsgBox "Error 1" Exit Sub ElseIf WorksheetFunction.Count(列) = 0 Then MsgBox "Error 2" Exit Sub End If Set 列 = 列.SpecialCells(xlCellTypeConstants, xlNumbers) For Each セル In 列 セル.Value = Round(セル.Value2, 2) セル.NumberFormatLocal = "0.00;-0.00;0" Next セル End Sub フリーズしないネットから頂いたり、自分で弄ったマクロ下↓ Sub ナンバリング() 'M列からAK列まで空白があろうが一番多い列をナンバリング Sheets("四捨五入挑戦").Select i = 15 '15行目から開始 'M列〜AK列が空白ではない場合にループ Do While Cells(i, "M") <> "" Or Cells(i, "N") <> "" Or Cells(i, "O") <> "" Or Cells(i, "P") <> "" Or Cells(i, "Q") <> "" Or Cells(i, "R") <> "" Or Cells(i, "S") <> "" Or Cells(i, "T") <> "" Or Cells(i, "U") <> "" Or Cells(i, "V") <> "" Or Cells(i, "W") <> "" Or Cells(i, "X") <> "" Or Cells(i, "Y") <> "" Or Cells(i, "Z") <> "" Or Cells(i, "AA") <> "" Or Cells(i, "AB") <> "" Or Cells(i, "AC") <> "" Or Cells(i, "AD") <> "" Or Cells(i, "AE") <> "" Or Cells(i, "AF") <> "" Or Cells(i, "AG") <> "" Or Cells(i, "AH") <> "" Or Cells(i, "AH") <> "" Or Cells(i, "AJ") <> "" Or Cells(i, "AK") <> "" Cells(i, "L") = i - 14 'L15=15-14で1が入る i = i + 1 'カウントアップ 'カウントアップ Loop End Sub '64bit版 Private Declare PtrSafe Sub keybd_event Lib "user32" ( _ ByVal bVk As Byte, _ ByVal bScan As Byte, _ ByVal dwFlags As Long, _ ByVal dwExtraInfo As Long _ ) Public Sub スクショ全体() keybd_event vbKeySnapshot, 0&, &H1, 0& keybd_event vbKeySnapshot, 0&, &H1 Or &H2, 0& End Sub Sub データを開く() Dim fn As Variant Dim openfn As Variant ChDrive "C" ChDir "C:¥Users¥●●●¥Desktop" 'パスを指定!!!!! 'ダイアログ表示 fn = Application.GetOpenFilename("えくせる,*.xls*;*.csv,てきすと,*.txt*", , "お好みのファイルを選んでください♪", , True) 'ファイルが選択された場合は開く If IsArray(fn) Then For Each openfn In fn Workbooks.Open openfn Next End If End Sub 本当の理想は M列15行目から空白になるまで0.01に四捨五入して書式も変更 それをAK列まで繰り返す 途中で空白の列があった場合は空白のまま何もしない が理想なのですがまだ弄る知識はなく15行目から9999行目までにセットしております。 長文になりすみませんがよろしくお願いします。 知識が無く扱いが悪いのは重々承知しております。 （カラス） 2023/02/20(月) 19:16:37 ---- すみません、長文のあまり、理想が完全に違いました。 M列からAK列までは選択した列が15行目から空白になるまで0.01に四捨五入して書式も変更 選択した列の15行目から空白の列があった場合は空白のまま何もしない です。 ただこちらは自分の力量では無理なので。 （カラス） 2023/02/20(月) 19:21:11 ---- もしかして: シートで揮発関数を使っている（RAND関数等） （ふなば） 2023/02/20(月) 20:31:45 ---- ふなば様 コメントありがとうございます。 M列からAK列までの2行目から12行目まで if関数 countifs関数 sum関数 などセルの数値を参照させる関数を結構使っております。 それが原因でしょうか? 自宅のPC→Ryzen5、メモリ8GB、SSD 会社のPD→Ryzen7 メモリ16GB SSD で自宅のPCスペックで問題ないなら、、と思ったのですが、 会社はデスクトップのデータもonedriveを同期する?仕様になっております。 ここで9999行とか指定させる事がだめなのでしょうか。。。 正直普段は使っても700行とかなのですがいざというときのために9999行にしております （カラス） 2023/02/20(月) 20:45:14 ---- Set 列 = 列.SpecialCells(xlCellTypeConstants, xlNumbers) '←データ入力済みセル自体が多くなければここで除かれるので大丈夫です 列.NumberFormatLocal = "0.00;-0.00;0" 'これはループ内でやらなくても良いので外しても良いと思います。 For Each セル In 列 '該当範囲内のセルごとに処理を行うのでここで渋滞が起きる可能性があります セル.Value = Round(セル.Value2, 2) 'この処理自体が重くなる原因とは考えづらいですが、このセルを参照する他のセルがある場合には要注意です Next セル Application.Calculation = xlCalculationManual 'これで手動再計算化 Application.Calculation = xlCalculationAutomatic 'これで自動再計算化 確証はありませんが、これらを使うことで多少の改善がみられるかもしれません。 （ふなば） 2023/02/20(月) 21:05:40 ---- ＞会社のセキュリティ?に引っかかっているのかわかりません。 私用のユーエスビーメモリ等の媒体の使用は許されいるんですか。 （MEMORY） 2023/02/20(月) 21:21:58 ---- Sub test() Dim rngTarget As Range Dim c As Range Dim a As Range With Selection If .Worksheet.Name <> "四捨五入挑戦" Then Exit Sub Set rngTarget = .EntireColumn End With With ActiveSheet Set rngTarget = Intersect(rngTarget, .Range("M:AK"), .UsedRange, .UsedRange.Offset(14)) End With If rngTarget Is Nothing Then Exit Sub If WorksheetFunction.Count(rngTarget) = 0 Then Exit Sub With rngTarget.SpecialCells(xlCellTypeConstants, xlNumbers) .NumberFormatLocal = "0.00;-0.00;0" For Each a In .Areas For Each c In a.Cells .Value = .Text Next Next End With End Sub 固まるのはちょっとわからないですねぇ。。 （まっつわん） 2023/02/20(月) 21:32:17 ---- ふなば様 ご指導本当にありがとうございます。 一度、手動にさせて処理させた後に自動化させるのですね、 検索したら出てきました。 本当にありがとうございます。 ループさせるマクロなどにも全部入れる癖をつけてみます。 MEMORY様 本当は良くないのでしょうが、自宅で簡単に資料とか作るのは容認されています。 いずれ会社PCも自宅に持ち帰ってよくなるそうですが。 上司にも仕事の事持ち帰らなくていいけど自分でスキルとか効率上げるためにって事なら 黙認するよと言われてます。 まっつわん様 新しいコードを助言して頂いてありがとうございます。 保存させて頂いて、モジュールに追加して試させて頂きます。 自分でコメントで一つずつ追えるようにしたいです。 皆様、本当にご迷惑をおかけします。 徹夜で今からやってみます。 （カラス） 2023/02/20(月) 21:55:01... - https://www.excel.studio-kazu.jp/wiki/kazuwiki/202302/20230217190936.txt - [detail] - similar
PREV
NEXT
Powered by Hyper Estraier 1.4.13, with 97057 documents and 608292 words.
訪問者：