[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]
『範囲外の列を選択してもエラーにならないようにしたいです』（カラス）
すみません。初心者ながらインターネットで調べて
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
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
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
[ 一覧(最新更新順) ]
YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki.
Modified by kazu.