[[20150220111053]] 『選択したセルを四捨五入する』(とらねこ) ページの最後に飛ぶ

[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]

 

『選択したセルを四捨五入する』(とらねこ)

選択したセルを小数点第二位で四捨五入するようにしたのですが動作完了までに時間がかかります。
いろいろなブックで使いたいので個人用マクロブックに記入しています
ユーザーフォームをモードレスにしてボタンを設置しています
ブックにはたくさんの関数が入っています
また関数式のセルをそのまま四捨五入しようとすることもあります
実行中に画面が白くなったりして最悪止まってしまうこともあります

Sub 選択セルを四捨五入する_個人()

    Application.ScreenUpdating = False
Dim CL
    For Each CL In Selection
     If CL <> "" Then CL.Value = WorksheetFunction.Round(CL, 2)
    Next
    Application.ScreenUpdating = True
End Sub

現在は上記のコードを使っています
何か方法がありましたら教えていただけないでしょうか

< 使用 Excel:Excel2010、使用 OS:Windows7 >


 通常、どれくらい広い範囲を指定するのですか?(セルの数)

 列指定とかはするんですか?(それだと、相当広い範囲となりますけど)

 >また関数式のセルをそのまま四捨五入しようとすることもあります 
  ↑
 これは、関数式のセルには手を入れたくない、と云う趣旨ですか?

(半平太) 2015/02/20(金) 11:31


 選択範囲に数式があった場合は問題ないのでしょうか。
 表示書式での対応ではなく、値を変える必要が有りますか?

    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
  処理
    Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = False
 としてどうでしょうか。

 Sub 選択セルの書式設定をする_個人() 
     Selection.NumberFormatLocal = "0.00"
 End Sub

 だけでも良いような気がしますが。

(Mook) 2015/02/20(金) 11:37


半平太様
早速のご回答ありがとうございます

多いのは35x6の範囲ですがそれより多くなることも少なくなることもあります
基本的に列指定はしません

関数式のセルは表示されている数値を四捨五入して大丈夫です
関数式は残らなくてOKです

(とらねこ) 2015/02/20(金) 11:38


Mook様
早速のご回答ありがとうございます

関数式のセルは表示されている数値を四捨五入して大丈夫です
関数式は残らなくてOKです

表示書式での対応ではなく…
とのことですが他のセルで関数による計算、判定をしていて計算結果が合わなくなることがあったので数値を変更しています
また関数式のあるセルを数値に直したいのは参照していた数値と関数を連動させたくないからです

Application.Calculation = xlCalculationManual
試してみたのですが実行速度に変化はないようです

(とらねこ) 2015/02/20(金) 11:52


最初の質問に書き忘れてしまったのですがブックには画像もありリンクさせているのは動作が遅いことと関係ないでしょうか?
(とらねこ) 2015/02/20(金) 11:54

 もしシートにイベントマクロがあるなら、
 Application.EnableEvents = False
 処理
 Application.EnableEvents = True
 も追加で。

(Mook) 2015/02/20(金) 12:10


Mook様

シートイベントにマクロはありません。

(とらねこ) 2015/02/20(金) 12:47


 取りあえず、以下でやってみてください。
 セル範囲は、連続した矩形で。(つまり、飛び飛びは無し)

 Sub 選択セルを四捨五入する_個人()
    Dim Val
    Dim NN As Long, MM As Long

    If Selection.CountLarge > 1000 Then
        MsgBox "範囲が広すぎます"
        Exit Sub
    End If

    Application.ScreenUpdating = False
        Val = Selection.Value

        For NN = 1 To UBound(Val)
            For MM = 1 To UBound(Val, 2)
                If Val(NN, MM) <> "" Then
                   Val(NN, MM) = WorksheetFunction.Round(Val(NN, MM), 2)
                End If
            Next MM
        Next NN

        Selection.Value = Val

    Application.ScreenUpdating = True
 End Sub

(半平太) 2015/02/20(金) 15:53


半平太様
早速試してみました

問題なく動きます 
しかも早い!!一瞬で終わったので動いてないのかと思ったくらいです(笑
有難うございます

    If Selection.CountLarge > 1000 Then
        MsgBox "範囲が広すぎます"
        Exit Sub
    End If
この部分は1000もセルを選択しないので削除させていただいてもいいでしょうか

厚かましいのですがセルの選択範囲を飛び飛びでも使えるようには出来ないでしょうか
もし不可能なら選択セルが飛び飛びの場合は実行しないように(マクロが止まらないように)出来ますでしょうか

(とらねこ) 2015/02/20(金) 16:38


 >この部分は1000もセルを選択しないので削除させていただいてもいいでしょうか

 そちらの自己責任で判断してください。
 一般論は「人間は間違いを犯す動物」です。百万行の処理に入り込まないことを祈ります。

 >セルの選択範囲を飛び飛びでも使えるように

 これで(↓) テストしてみてください。

 Sub 選択セルを四捨五入する_個人()
     Dim Val, rngToProc As Range
     Dim NN As Long, MM As Long

     If Selection.Cells.CountLarge > 1000 Then
         MsgBox "範囲が広すぎます"
         Exit Sub
     End If

     Application.ScreenUpdating = False
         For Each rngToProc In Selection.Areas
             Val = rngToProc.Value
             If rngToProc.Cells.Count = 1 Then
                 Val = WorksheetFunction.Round(Val, 2)
                 rngToProc.Value = Val
             Else
                 For NN = 1 To UBound(Val)
                     For MM = 1 To UBound(Val, 2)
                         If Val(NN, MM) <> "" Then
                            Val(NN, MM) = WorksheetFunction.Round(Val(NN, MM), 2)
                         End If
                     Next MM
                 Next NN
                 rngToProc.Value = Val
             End If
         Next
     Application.ScreenUpdating = True
 End Sub

(半平太) 2015/02/20(金) 17:16


半平太様

百万行の処理に入り込まないことを祈ります。
そうですね
間違えてクリックしてしまうことがあったら大変なので残しておくことにします

新たに作っていただき有難うございます
今すぐに確認出来ないので確認が出来次第改めて書き込みにきます

とても助かりました
有難うございました
(とらねこ) 2015/02/20(金) 20:10


半平太様

確認できました
完璧です
やりたいことすべてが出来ました!

本当に感謝です
有難うございました

(とらねこ) 2015/02/23(月) 08:35


コメント返信:

[ 一覧(最新更新順) ]


YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki. Modified by kazu.