- ベストアンサー
VBAの処理時間表示で小数点以下を四捨五入したい。
VBAで処理の時間を終了後にメッセージボックスに表示するのですが、以下のようにすると小数点以下沢山の数があります。処理の時間が短くこれが時間なのかシリアル値であるのか判別つきません。時間であれば小数点以下をなくしたいです。シリアル値であればそれを時間に直したいです。教えてください。 Dim Time, StartTime, EndTime As Date starttime = Now ... ... ... endtime =Now Time =endtime - starttime msgbox ・・・
- みんなの回答 （1）
- 専門家の回答
質問者が選んだベストアンサー
関連するQ&A
- 小数点以下表示
averageで計算した値を表示したところ、 勝手に四捨五入されてしまいました 小数点第二位まで表示したいので どなたかよろしくお願いいたします<m(__)m> Option Explicit Public Sub 平均() Const SH_NAME As String = "VBA" Dim art As String Dim i Dim ws As Worksheet Dim endrow As Long Dim msg As String Dim writerow As Integer Dim target As Range Dim ActCell As Variant Dim Result As Integer Set ws = ThisWorkbook.Worksheets(SH_NAME) writerow = 2 art = InputBox("日付を入力してください") With ws endrow = .Cells(Rows.Count, 2).End(xlUp).Row For i = 2 To endrow If art = .Range("A" & i) Then If target Is Nothing Then Set target = Range("D" & i) Else Set target = Union(target, Range("D" & i)) End If Else If InStr(msg, .Range("A" & i)) = 0 Then msg = msg & .Range("A" & i) & vbCrLf End If End If Next i If msg <> "" Then MsgBox msg End If target.Select ActCell = Selection.Address Result = Application.WorksheetFunction.Average(.Range(ActCell)) Range("F39").Value = Result Range("F39").NumberFormatLocal = "0.00" End With End Sub
- ベストアンサー
- Visual Basic
- VB6.0での小数点の扱いについて
現在、VB6.0を使用しており、小数点の扱いに困っています。 Sub Keisan() Dim A As String Dim B As String Dim C As String A = 1.29033 B = 1.91458 C = CStr(A + CDec((B - A) / 6) * 3) MsgBox C End Sub 上記のプログラムを実行すると、 「1.602455000000001」と表示されますが、 電卓を用いて計算すると、 「1.602454998・・・」となり、微妙に誤差が出てしまいます。 小数点を整数にして計算→元の桁数に戻す、という 処理を行うと、誤差なく求めることが出来ましたが、 「もっとスマートなコードにして」と言われてしまいまして どうしたものかと思っております。 この誤差を解決する方法は無いでしょうか？
- ベストアンサー
- Visual Basic
- vba 四捨五入 について教えてください。
VBA初心者です。お世話になりますがよろしくお願いします。 vbaでRound関数を使って四捨五入したいと考えております。 以下のコードで実行するとエラー(プロシージャの呼び出し,または引数が不正です。）が出ます。 何がなんだかわからずに困っております。 どうかご教授よろしくお願いします。 Sub 計算() Worksheets("abc").Activate Dim LastRow As Long Dim i As Integer LastRow = Worksheets("abc").Range("K65536").End(xlUp).Row For i = 6 To LastRow If Cells(i, 11) = 0 Then Cells(i, 12) = "" Else Cells(i, 12) = Round(Cells(i, 9) / Cells(i, 11),-2) End If Next End Sub
- ベストアンサー
- Visual Basic
- VBAの時間計算
エクセルのVBAで時間を比較して処理するために以下のプログラムを書いています。 しかしオーバーフローが出てうまくいきません。 お手数ですが解決方法を教えてください。 dim NowTime as Long h = Hour(Now) m = Minute(Now) s = Second(Now) NowTime = ((h*60)*60)+(M*60)+s 宜しくお願いいたします。
- ベストアンサー
- Excel（エクセル）
- (VBA) 処理から外すコードを追加
翻訳処理を行っています。 処理DATAはA列で１グループが以下の構造です。 連番（１から始まる） 表示時間（開始時間 --> 終了時間なので必ず文字列の「-->」を含んでいます） 字幕部分（1-3行） 区切り(""相当） 参考（SRTファイル構造） https://docs.fileformat.com/ja/video/srt/ 現在は、 ネットに1行ずつ送って処理してるのでサンプルDATAが90行で13秒程必要です。 連番部分と表示時間部分はネットに送る必要が無いので これを省くとかなり高速化が見込めると思うのですが 以下のコードで連番部分と表示時間部分を処理から外すコードを教えてください。 Sub 翻訳withGoogle() Dim ln As Long Dim i As Long Dim startTime As Double Dim endTime As Double Dim processTime As Double Dim ws2 As Worksheet Set ws2 = Worksheets("Slim") ln = ws2.Cells(Rows.Count, "A").End(xlUp).Row '最終行番号の取得 MsgBox "処理に時間が必要です。 気長に待ってください." '日本語化 書き出し列(B)の初期化 ws2.Columns(2).Clear '英文の翻訳(A列)を対象に日本語に翻訳 Dim temp() temp = ws2.Range("A1").Resize(ln, 1).Value Dim result() ReDim result(1 To UBound(temp), 1 To 1) '開始時間取得 startTime = Timer Dim objHTTP As Object, oHtml As Object Set objHTTP = CreateObject("MSXML2.ServerXMLHTTP") Set oHtml = CreateObject("htmlfile") For i = LBound(temp, 1) To UBound(temp, 1) 'HTTPリクエストのURL設定 Const SRC_URL As String = "https://translate.google.pl/m?hl=jp&sl=en&tl=jp&ie=UTF-8&prev=_m&q=" Dim url As String url = SRC_URL & temp(i, 1) 'HTTPリクエスト objHTTP.Open "GET", url, False objHTTP.setRequestHeader "User-Agent", "Mozilla/4.0 (compatible; MSIE 6.0; Windows NT 5.0)" objHTTP.send ("") '翻訳結果の取得 - HTTPリクエストのレスポンステキストを取得 oHtml.body.innerHTML = objHTTP.responseText '翻訳結果を取得 Dim transtext As String transtext = oHtml.getElementsByClassName("result-container")(0).innerText '翻訳結果があればClean関数を実行、なければエラー出力 If transtext <> "" Then result(i, 1) = Clean(transtext) Else result(i, 1) = CVErr(xlErrValue) End If Next 'SlimシートのC列に日本語化した翻訳を書き出す ws2.Range("B1").Resize(ln, 1).Value = result 'エラーセルを処理 For i = 1 To ln If IsError(Cells(i, "B").Value) Then Cells(i, "B") = "" End If Next '終了時間取得 endTime = Timer '処理時間計算 processTime = endTime - startTime MsgBox "翻訳終了 / 処理時間：" & processTime Set ws2 = Nothing Set objHTTP = Nothing Set oHtml = Nothing End Sub
- ベストアンサー
- Excel（エクセル）
- Excelの小数点以下表示・非表示の方法について
Excel2000において、小数点以下の表示方法について教えてください。 条件は以下の通りです。 (1)小数点以下が存在するときは、小数点以下第2位まで表示する。 ※小数点以下第3位の処理は、切捨てでも四捨五入でも何でも構いません。 (2)小数点以下が存在しないとき（整数のとき）は、少数点以下は非表示。※小数点も非表示に。 ・・・というものです。 ご存知の方がいらっしゃいましたら、何卒ご協力くださいますようお願いします！
- ベストアンサー
- オフィス系ソフト
- 小数点４桁での四捨五入がうまくいきません
エクセルで次のような計算をさせます。 A2 に1.8、B2に0.075、C2に0.075、 D2に= A2*B2*C2 、E2に=roundup(D2,4) D2の計算結果は 0.010125 です。小数点第5桁目の値を参照して第４桁目で四捨五入したいのですが、roundupでは0.0102、rounddownでは0.0101です。 表示させたいのは0.0101です。この場合、rounddownを使えば問題ないのですが、逆にrounddownだと小数点以下４桁目の四捨五入がうまくいかない場合もあります。 例えば A3に2.7 B3に0.08、C3に0.08 があり、E3にすべての値を掛けた結果を表示させると0.01728となります。 =roundup(E3,4)では0.0173となり、rounddownでは0.0172となります。この場合はroundup関数の結果である0.0173が求める数値です。 A列、B列,C列に任意の数字が入り、E列に４桁目で四捨五入した正確な値を求めたいのですが、なにか良い方法はないでしょうか。 VBAを使っても構いません。ちなみにこれは木材の材積計算に使用する目的です。 よろしくお願いします。
- ベストアンサー
- Excel（エクセル）
- Excel VBA onTime関数のプロシージャ引数に、引数（変数）つきのプロシージャを呼び出す方法を教えてください。
現在ExcelVBAで一定時間ごとにメッセージを出すツールを作成しています。 その際にonTime関数を使っていますが、その引数のひとつである呼び出すプロシージャに「引数（変数）つきのプロシージャ」を設定しようとしています。 サイトを探してみたところ、引数にシングルクオーテーションで囲むなど書いてあったのですが、変数を引数としたプロシージャを設定すると、「プロシージャが見つかりません」のエラーがでます。 どなたかお力を貸してくれませんでしょうか。 ちなみに僕のコードは以下の通りです。（簡略化） ------フォーム Private Sub cmbOk_Click() Call メッセージ実行(txtTime.Text, txtContent.Text) End Sub ------ThisWorkbook Private Sub メッセージ実行(ByVal time As String, ByVal content As String) Dim starttime As Double MsgBox time & "毎に" & vbCr & content & vbCr & "を表示します。", vbInformation Unload frmSet starttime = Now + CDbl(TimeValue(time)) Application.OnTime starttime, "'expressContent" & time & content & "'" End Sub ------標準モジュール Dim starttime2 As Double Sub expressContent(ByVal time2 As String, ByVal content2 As String) MsgBox "content2", vbInformation starttime2 = Now + CDbl(TimeValue(time2)) Application.OnTime starttime2, "'expressContent" & time & content & "'" End Sub よろしくお願い致します。
- 締切済み
- SE・インフラ・Webエンジニア
- タイムスタンプを挿入して、時間の経過に合わせて色
Q列に同じ行のA列に文字が入ると、タイムスタンプを挿入して、時間の経過と共に、720時間かけて白から赤にグラデーション変化する。 上記のVBAを行いたいのですが、オーバーフローエラーが発生します。どの様に修正すれば良いでしょうか？ Private Sub Worksheet_Change(ByVal Target As Range) Dim currentDate As Date Dim startTime As Date Dim endTime As Date If Target.Column <> 1 Or Target.Cells.Count > 1 Then Exit Sub If Target.Offset(0, 15).Value = "" And Target.Value <> "" Then startTime = Now() Target.Offset(0, 15).Value = startTime ElseIf Target.Offset(0, 15).Value <> "" And Target.Value = "" Then endTime = Now() Target.Offset(0, 15).Value = "" End If currentDate = Now() If Target.Offset(0, 15).Value <> "" Then Target.Offset(0, 16).Interior.Color = GradientColor(Target.Offset(0, 15).Value, currentDate, startTime, 720) Else Target.Offset(0, 16).Interior.Color = RGB(255, 255, 255) End If End Sub Function GradientColor(ByVal timeStart As Date, ByVal timeEnd As Date, ByVal startTime As Date, ByVal duration As Integer) As Long Dim secondsElapsed As Long Dim fractionTimeElapsed As Double secondsElapsed = DateDiff("s", startTime, timeEnd) ➡︎ fractionTimeElapsed = secondsElapsed / (duration * 3600) fractionTimeElapsed = IIf(fractionTimeElapsed > 1, 1, fractionTimeElapsed) GradientColor = RGB(255 * (1 - fractionTimeElapsed), 255 * fractionTimeElapsed, 255 * fractionTimeElapsed) End Function
- ベストアンサー
- Visual Basic
お礼
有難う御座います。