• ベストアンサー

EXCEL VBAで計算値を四捨五入、切り上げ、切捨てする方法

ネットで探してみたのですが、計算結果を四捨五入して特定のセルを 返すにはどうしたらいいのでしょうか? Sub hokangosa() Dim ZPS As Double Dim ZPOS As Double Dim DMN As Double MsgBox (" >>> 補間誤差自動計算 <<< ") MsgBox (" >>> 初期値入力します <<< ") ZPS = InputBox(">>> ステップを入力してください<<<") ZPOS = Sheet1.Cells(22, 4).Value DMN = ZPOS / ZPS Sheet1.Cells(23, 6).Value = DMN End Sub ここでDMNの値を四捨五入したいです。 またこれとは別に切上げ、切捨ても教えていただけるとありがたいです。

  • dadao
  • お礼率79% (85/107)

質問者が選んだベストアンサー

  • ベストアンサー
  • merlionXX
  • ベストアンサー率48% (1930/4007)
回答No.2

DMN = Application.WorksheetFunction.Round(ZPOS / ZPS, 0) で、四捨五入 DMN = Application.RoundDown(ZPOS / ZPS, 0) で切り捨て DMN = Application.RoundUp(ZPOS / ZPS, 0) で切り上げです。 引数で、対象桁を変更できます。

dadao
質問者

お礼

四捨五入とはいわず、worksheetFunctionという手はいろいろ使えそうですね。 ありがとうございました。

その他の回答 (1)

  • zap35
  • ベストアンサー率44% (1383/3079)
回答No.1

VBAでもワークシート関数が使えますから DMN = Application.RoundDown(ZPOS / ZPS, 1) DMN = Application.RoundUp(ZPOS / ZPS, 1) のように記述したらどうですか。小数点以下の桁数は変更してください

dadao
質問者

お礼

ありがとうございます。 なるほど、桁数の指定もできるんですね。 ありがとうございました。

関連するQ&A

  • 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

  • エクセルの四捨五入について

    数枚のシートで計算した結果をまとめて一枚のシートに表にしたいのですが、コピー&ペーストでやると、はりつけた先の値が四捨五入されてしまいます。物理の実験のデータなので四捨五入されてしまうと誤差を求められません。。解決策教えていただけますか?

  • VBAでの拡散計算

    エクセルのVBAを使って添付画像のようなグラフを作成しようと考えています。 以下の計算で作成できそうなのですが、⊿tを10-5より小さく設定し、1000sec~の濃度変化が知りたいため表計算ではなくVBAを使ってみました。 表計算では、 t=0のときx0=C0(飽和濃度)、x>x0でC=0とし(初期条件) x0では、 C(j+1,i) = C(j,i) +D * ( C(j,i-1) - C(j,i) ) / dx / dx * dt x >x0では、 C(j+1,i) = C(j,i) +D * ( C(j,i-1) - 2 * C(j,i) + C(j,i+1) ) / dx / dx * dt の計算を行い、セル表記が以下のようになりました。どの時間も物質量は一定です。(たぶん・・・)   t0、t1、t2、t3t、・・・ x1,60、58.8、57.6・・・ x2, 0、 1.2、2.38・・・ x3, 0、 0、0.02・・・ 上の計算をVBAで以下のように書いてみました。 Sub diffusion_dry_up2() Dim n As Integer, nt As Integer Dim i As Integer, j As Integer Dim b As Double, te As Double, dt As Double Dim c0 As Double, cs As Double, d As Double Dim x As Double, dx As Double, t As Double Dim a As Double, cjp As Double, cj0 As Double Dim cjm As Double b = InputBox("配管の長さb(m)") n = InputBox("配管の長さの方向分割数n") te = InputBox("計算する時間長t(sec)") dt = InputBox("時間増分dt(m)") c0 = InputBox("配管底部の濃度c0(vol.%)") cs = InputBox("時刻t=0の時の配管内の濃度cs(vol.%)") d = InputBox("拡散係数d(m^2/sec)") Sheet1.Cells(1, 2) = "配管の長さb(m)" Sheet1.Cells(2, 2) = "配管の長さの方向分割数n" Sheet1.Cells(3, 2) = "計算する時間長t(sec)" Sheet1.Cells(4, 2) = "時間増分dt(sec)" Sheet1.Cells(5, 2) = "配管底部の濃度c0(vol.%)" Sheet1.Cells(6, 2) = "時刻t=0の時の配管内の濃度cs(vol.%)" Sheet1.Cells(7, 2) = "拡散係数(m^2/sec)" Sheet1.Cells(1, 3) = b Sheet1.Cells(2, 3) = n Sheet1.Cells(3, 3) = t Sheet1.Cells(4, 3) = dt Sheet1.Cells(5, 3) = c0 Sheet1.Cells(6, 3) = cs Sheet1.Cells(7, 3) = d nt = te / dt dx = b / n Sheet1.Cells(1, 1) = nt t = 0 a = d * dt / dx ^ 2 Sheet1.Cells(1, 5) = t Sheet1.Cells(1 + 1, 4) = -dx Sheet1.Cells(1 + 2, 5) = c0 Sheet1.Cells(1 + n + 2, 4) = b + dx Sheet1.Cells(1 + n + 3, 5) = cs Sheet1.Cells(3, 5 + i) = a * (-cj0 + cjp) + cj0 For i = 1 To nt t = t + dt Sheet1.Cells(1, 5 + i) = t Sheet1.Cells(1 + n + 3, 5 + i) = a * (cjp - 2 * cjo + cjm) + cj0 For j = 2 To n + 2 cjp = Sheet1.Cells(1 + j + 1, 5 + i - 1) cj0 = Sheet1.Cells(1 + j + 0, 5 + i - 1) cjm = Sheet1.Cells(1 + j - 1, 5 + i - 1) Next j Next i linegraph 2, 4, 4 + n, nt + 2 End Sub Sub linegraph(sr As Integer, sc As Integer, lr As Integer, lc As Integer) ActiveSheet.ChartObjects.Add(200, 10, 240, 200).Select ActiveChart.ChartWizard _ Source:=Range(Cells(sr, sc), Cells(lr, lc)), _ gallery:=xlXYScatter, _ Format:=3, _ PlotBy:=xlColumns, _ categoryLabels:=1, _ SeriesLabels:=0, _ HasLegend:="false", _ Title:="ex2", _ categoryTitle:="t", _ ValueTitle:="y", _ ExtraTitle:="" End Sub しかしまったく表計算のようになりませんでした。 a = d * dt / dx^2以降の書き込みが変だと思うのですが、どのようにすればよいのでしょうか。 また、上のような表記ではtを大きくdtを小さくするとエラーになってしまいます。 質問項目が多いですが、よろしくお願いします。

  • エクセルVBAで

    登録ボタンを作りたいのですが うまくいきません。 応答無しになってしまいます。 仕事でコードを入力して、住所やその他の関連事項を 登録して、検索し、封筒に宛名印刷し、登録内容の修正をしたいと思っています。 登録ボタンは下記のようなものを作りました。 Private Sub CommandButton1_Click() Dim bk As Workbook Dim sh1 As Worksheet Dim sh2 As Worksheet Dim cnt1 As Long Set bk = ThisWorkbook Set sh1 = bk.Worksheets("現場登録検索") Set sh2 = bk.Worksheets("一覧") cnt1 = 6 Do While sh2.Cells(cnt1, 2).Value <> "" cnt = cnt1 + 1 Loop '得意先CD sh2.Cells(cnt1, 2).Value = sh1.Cells(2, 3).Value '現場CD sh2.Cells(cnt1, 3).Value = sh1.Cells(3, 3).Value '送り方 sh2.Cells(cnt1, 22).Value = sh1.Cells(4, 3).Value '封筒 sh2.Cells(cnt1, 23).Value = sh1.Cells(5, 3).Value MsgBox "登録できました。" End Sub 何が悪いのでしょうか? よろしくお願い致します。

  • EXCEL VBA におけるブック終了後の値の保存方法について

    EXCEL VBAについて質問があります。もしかしたら初歩的なことかもしれませんがよろしくお願いいたします。 まず、 Sub Test() Dim i As String i = InputBox("好きな果物を入力してください") Sheets("Sheet1").Range("A1").Value = i End Sub を実行し、ブックを保存して終了する。 ブックを開く Private Sub Workbook_Open() Dim k As String k = Sheets("Sheet1").Range("A1").Value If k = "みかん" Then MsgBox ("a") Else: MsgBox ("b") End If End Sub この処理を Sheets("Sheet1").Range("A1").Value = i というシート上のセルに値を保存するという方法を取らずに iの値をブック終了後もプロシージャ内に持っておくというのは可能なのでしょうか。 Publicで宣言してもブックを一度閉じると やっぱりiの値は保存されませんでした。 どうぞよろしくお願いいたします。

  • エクセルVBAで

    全シート保護(保護の解除)のコードなんですが、パスワードを求めない形にするには下記をどうすれば良いのですか? Sub 全シート保護の設定() Dim Sh As Worksheet x = Application.InputBox("パスワードを入力して下さい", Type:=3) For Each Sh In Worksheets Sh.Protect (x) Next Sh End Sub Sub 全シート保護の解除() Dim Sh As Worksheet On Error GoTo ErLine Do x = Application.InputBox("パスワードを入力して下さい", Type:=3) Loop While x = "False" For Each Sh In Worksheets Sh.Unprotect Password:=x Next Sh Exit Sub ErLine: y% = MsgBox("パスワードが違います ! 終了します", 48) End Sub 毎度すみませんがよろしくお願いします。

  • ExcelのVBAについて(勉強中のです。)

    ExcelのVBAについて(勉強中のです。) ここからコード3以降に入力したコードを抜き出してデータ表を作成しそれを保存するコードを作成したいです。例えばCSV形式にするとか? データ表は1日分の表示で、保存して週間や月間または統計データまでを視野にいれています。今回は保存する所です。。 利用しやすい状態と保存形式で、よろしくお願いします。データは生活記録みたいなものです。何したどうしたどうなった? ※大分分岐する予定で、作成中であり、今回はコードの整理は不要です。 '///Sheet1/// Private Sub Worksheet_Change(ByVal Target As Excel.Range) Dim time7 As Range For Each time7 In Target If time7.Column = 1 Then time7.Offset(0, 4).Value = Format(Now, "Short Time") & vbCrLf & _ Format(Now, "yyyy/mm/dd hh:nn:ss AM/PM") End If Application.EnableEvents = False Application.EnableEvents = True Next time7 '(1)シートを変数にセット Dim ws1 As Worksheet Dim ws2 As Worksheet Set ws1 = Worksheets("Sheet1") Set ws2 = Worksheets("Sheet2") '(2)シートを指定してデータを転記 ws2.Range("A3:H3").Value = ws1.Range("A3:H3 ").Value End Sub Private Sub Worksheet_Activate() ' ' 新規行挿入 ' ' Worksheets("Sheet2").Range("3:3").Insert Sheets("Sheet1").Range("H3").Select ActiveCell.FormulaR1C1 = "5" Sheets("Sheet1").Range("E3").Select Selection.ClearContents Dim str_Left As String 'セルE4に文字列、セルH4に数字を予め入れておくこと。 str_Left = Left(Cells(4, 5), Cells(4, 8)) MsgBox str_Left & vbCrLf & " " & "OKボタンを押してください!" Sheets("Sheet1").Range("A3").Select Dim se_r As String se_r = Application.InputBox("バーコードを入力してください") Select Case se_r Case "False" MsgBox "キャンセルされました" Case "" MsgBox "空欄が入力されました" Case Else Range("A3").Value = se_r End Select End Sub ' ///Sheet2/// Private Sub Worksheet_Activate() Dim Emp(1 To 300) As String Dim msg As String Dim i, i2, Cnt As Integer Dim N_In As Variant For i = 3 To 3 If IsEmpty(Cells(i, 1).Value) = False Then 'ここで空欄判定 Worksheets("Sheet1").Range("3:3").Insert '対象セルアドレスを改行処理 End If Next i '(1)シートを変数にセット Dim ws1 As Worksheet Dim ws2 As Worksheet Set ws1 = Worksheets("Sheet1") Set ws2 = Worksheets("Sheet2") ws1.Activate End Sub

  • VBA sumifで計算できません

    集計シートに入力シートから抽出した重複しない検索データの合計値を入力シートでSUMIFで書いてみましたが  「オブジェクトはこのプロパティまたはメソッドをサポートしていません。」とエラーになります。 何がいけないのか調べてみましたがVBA初心者でわからず困っています。 教えてください。よろしくお願いします。 Dim 集計データ数 As Long Dim 入力シートデータ数 As Long Dim データ行 As Long 集計データ数 = Cells(Rows.Count, 38).End(xlUp).Row 入力シートデータ数 = Worksheets("入力").Cells(Rows.Count,29).End(xlUp).Row For データ行 = 11 To 集計データ数 Cells(データ行, 11).Value = Application.WorksheetFunction.SumIf(Worksheets("入力").Range(Cells(11, 29), Cells(入力シートデータ数, 29)),Cells(データ行, 2), Worksheets("入力").Range(Cells(11, 21), Cells(データ行, 21))) Next データ行 End Sub

  • EXCEL VBAでimput Boxメソッドを使用について

    Public Sub test() Dim LL As Double MsgBox = "距離を指定してください。マウスで操作できます。" MsgTitle = "距離指定" LL = Application.InputBox(Prompt:=MsgBox, Title:=MsgTitle, _Type:=1) If LL > 99999 Then U1 = 0 MsgBox "距離は無限大で,初期角度は" & U1 & "です。" Else U1 = -1 / (LL + Sheet1.Cells(15, 3).Value) MsgBox "距離は" & LL & "で,初期角度は" & U1 & "です。" End If End Sub 見よう見まねで上記のプログラムを作成しましたが、 「コンパイルエラー:代入式の左辺の関数呼び出しは、オブジェクト型かバリアント型の値を返さなければいけません。」となってしまいますがエラーの意味がちょっと良くわかりません。 これを動かそうとしたときどうしたらいいのでしょうか?

  • エクセル2019 VBAについて

    エクセル2019でVBAを使いコピーペーストの勉強中です、次の箇所(Dim i As integr)で、ユーザー定義型は定義されていませんと指摘されて止まってしまします、Sheet("データ")には3行のデータは入っています、VBA初心者のため、この後が、なかなか前に進めません、どうかよろしくおねがいします。 ********************************** Sub 練習() Dim s1 As Worksheet: Set s1 = Worksheets("請求書") Dim s2 As Worksheet: Set s2 = Worksheets("データ") Dim r1 As Integer: r1 = 18 Dim r2 As Integer: r2 = 2 { Dim i As integr } For i = 0 To 2 s1.Range(s1.Cells(r1 + i, 1), s1.Cells(r1 + i, 3)).Value = s2.Range(s2.Cells(r2 + i, 2), s2.Cells(r2 + i, 4)).Value s1.Cells(r1 + i, 4).Value = s1.sells(r1 + i, 2).Value * s1.Cells(r1 + i, 3).Value Next End Sub ***************************************

専門家に質問してみよう