• 締切済み

MicrosoftaccessVBAの計算

こんにちは。VBAで分からない点があるので教えてください。 下記なのですが、負割が[200]の時、[点数]×3で200を越えたら[負担金]フィールドの答えが200 それ以下は×3して四捨五入した数にしたいです。 それがどうしてもできません。 [負割]が200以外の場合は、[点数]×[負割]の出た数を四捨五入した答えを負担金フィールドに表示したいです。 お手数ですがどなたか教えてください。 Private Sub 負担金_BeforeUpdate(Cancel As Integer) If [負割] = 200 Then If [点数] * 3 > 200 = X Then X = 200 Else If ([点数] * 3 Mod 10) < 5 Then X = [点数] * 3 - ([点数] * 3 Mod 10) Else X = [点数] * 3 - ([点数] * 3 Mod 10) + 10 End If If [負割] < 199 Then If [点数] * [負割] Then Else If ([点数] * [負割] Mod 10) < 5 Then X = [点数] * [負割] - ([点数] * [負割] Mod 10) Else X = [点数] * [負割] - ([点数] * [負割] Mod 10) + 10 End If Public Function Rounds(ByVal M As Currency, _ ByVal A As Integer, _ Optional D As Integer = 0) As Variant Dim R As Currency Select Case A Case 0 ' 四捨五入 R = Fix(M * 10 ^ D + 0.5@) Case 1 '切り捨て R = Fix(M * 10 ^ D) Case 2 ' 切り上げ R = Rounds(M * 10 ^ D + 0.4@, 0) End Select Rounds = Sgn(M) * (R / 10 ^ D) End Function

みんなの回答

  • chie65535
  • ベストアンサー率43% (8524/19373)
回答No.1

何がしたいのか良く判らないが、少なくとも If [点数] * 3 > 200 = X Then の文は間違っている。

関連するQ&A

  • access VBA 計算について

    すいません。 http://qa.itmedia.co.jp/qa9245657.html で質問したのですがわかりにくいこのこの上ないと思うので、画像を添付させていただきました。 まるでかこった部分でできないものです。 関係するのは 点数 負割 入金 負担金 値引き なのですが [点数]*[負割]=負担金(四捨五入) が主な式で、これに負担金-入金=値引き という式はできています。 例外が負割が200の時で 200の時のみ、[点数]×3 という式にしたいのです これに出た数は 200以上の場合   例 600(点数)×3=1800 答えは1800ですが、強制的に200にしたいんです。 200以下の場合  45(点数)×3=135(第一位四捨五入で140) としたいのです。 例外200の場合がうまくいかないので、お分かりになる方お知恵をお貸しください。お願いします。 私が考案して間違えている式は以下になります。 Private Sub 負担金_BeforeUpdate(Cancel As Integer) If [負割] = 200 Then   If [点数] * 3 > 200 = X Then     X = 200   Else     If ([点数] * 3 Mod 10) < 5 Then       X = [点数] * 3 - ([点数] * 3 Mod 10)     Else       X = [点数] * 3 - ([点数] * 3 Mod 10) + 10     End If      If [負割] < 199 Then   If [点数] * [負割] Then   Else     If ([点数] * [負割] Mod 10) < 5 Then       X = [点数] * [負割] - ([点数] * [負割] Mod 10)     Else       X = [点数] * [負割] - ([点数] * [負割] Mod 10) + 10     End If Public Function Rounds(ByVal M As Currency, _             ByVal A As Integer, _             Optional D As Integer = 0) As Variant   Dim R As Currency     Select Case A     Case 0 ' 四捨五入       R = Fix(M * 10 ^ D + 0.5@)     Case 1 '切り捨て       R = Fix(M * 10 ^ D)     Case 2 ' 切り上げ       R = Rounds(M * 10 ^ D + 0.4@, 0)   End Select   Rounds = Sgn(M) * (R / 10 ^ D) End Function

  • Microsoftのaccessのクエリ関数につい

    「負割」というフィールドがあり、0、1、2、3、200という数字が1つ選択できます。これを選択すると、「点数」というフィールドの数字と掛算されます。この合計額が「負担金」というフィールドに表示されるのですが、 ・0,1,2,3のどれかを選択した場合、 IIf(([点数]*[負割] Mod 10)<5,[点数]*[負割]-([点数]*[負割] Mod 10),[点数]*[負割]-([点数]*[負割] Mod 10)+10)) で四捨五入されます。 ・200という数字が選択されると、「点数」×「3」の合計が199まではそのまま計算された数字で表示されますが、200や200を超えても「200」にしかならない。という式を作りたいと思っています。 できないことはこの「200」という数字が選択されたときの関数で IIf([負割]>199,(IIf([点数]*3)>200,200,(IIf(([点数]*3 Mod 10)<5,[点数]*3-([点数]*3 Mod 10),[点数]*3-([点数]*3 Mod 10)+10))),(IIf(([点数]*[負割] Mod 10)<5,[点数]*[負割]-([点数]*[負割] Mod 10),[点数]*[負割]-([点数]*[負割] Mod 10)+10))) このように導き出したのですが、関数が正しくありません。 間違っているのがわかる方、いらっしゃったら教えてください。お願いします。

  • [VBA] IFと絶対値の組み合わせ

    テキストボックスを利用して計算する時にIF文を利用しているのですが、以下の条件での計算が上手くいきません。 ・テキストボックスは3つ。オブジェクト名はD1、D2、D ・D1とD2に数値が入力されると同時に計算する(Changeイベント) ・D1は正の値のみを持つ ・D2は正、0、負の値を持つ 上手くいかない部分 ・条件:D2が負の値を取る時、絶対値がD1より大きい場合は計算する。                         D1より小さい場合は計算しない。 構文は下記の通りです。 Private Sub D1_Change() Dim R1 As Single Dim R2 As Single Dim R As Single If IsNumeric(D1) And D1 > 0 And D1 <> "" Then R1 = D1 / 2 Else D = "" Exit Sub End If If IsNumeric(D2) Then Else D = "" Exit Sub End If If D2 = 0 Then R = R1 ElseIf D2 > 0 Then R2 = D2 / 2 R = 1 / (1 / R1 + 1 / R2) ElseIf D2 < 0 Then If Abs(D2) > D1 Then R2 = D2 / 2 R = 1 / (1 / R1 + 1 / R2) Else D = "" Exit Sub End If Else D = "" Exit Sub End If D = Format(R * 2, "##.###") End Sub これで計算すると、D2が負の値で且つ絶対値がD1より大きい時、 If Abs(D2) > D1 Then R2 = D2 / 2 R = 1 / (1 / R1 + 1 / R2) Else D = "" Exit Sub End If の部分でElseの方で計算が進んでしまいます。 (Abs(D2)>D1でなく、D2>D1として計算している?) 何かよい構文はありませんでしょうか?

  • 素数の計算について教えてください

    「2以上の整数を入力すると、入力した数まで素数をすべて表示する。」 どこが間違っているか教えてください!! 5行目あたりからだと思うのですが・・・。 お願いします!! Dim Number As Long If Long.TryParse(TextBox1.Text, Number) AndAlso Number >= 2 Then For i As Integer = 2 To Number Step 1 Dim d As Long = 2 Do Until Number Mod d = 0 d = d + 1 Loop If d = Number Then Label1.Text = " " & i Else Label1.Text = "2以上の整数を入力してください" End If Next End If End Sub

  • Accessレポートで1行おきに色を変える

    Private Sub 詳細_Print(Cancel As Integer, PrintCount As Integer) FontCount = FontCount + 1 If FontCount Mod 2 = 1 Then Me.Section(0).BackColor = 16777215 Else Me.Section(0).BackColor = 16777164 End If End Sub としてみました。 ですが何らかわりなく… 試しに Private Sub 詳細_Print(Cancel As Integer, PrintCount As Integer) FontCount = FontCount + 1 If FontCount Mod 2 = 1 Then Me.Section(0).BackColor = 16777215 Else Me.Section(0).BackColor = 16777164 End If MsgBox FontCount End Sub としてみたところずーっと「1」が表示され、変数がかわってないようです。 いったいどこがダメなのでしょうか? 確か以前できたはずなのに…(><)

  • ボタンが押されたときの反応 Basic

    Active Basicでゲームプログラムを書いています。 ボタンを押したときの反応で、上下左右に画像を動かしたいのですが、 ボタンを押すと、いったん静止してから、連打処理(?)のように動きます。 やりたいことは、ボタンを押すとすぐに上下左右に一定間隔で画像を動かすことです。 Sub MainWnd_KeyDown(KeyCode As Long, flags As Long) If KeyCode=37 Then If x<=3 Then Exit Sub End If MyBmpInfo=2 x=x-5 Else If KeyCode=38 Then If y<=0 Then Exit Sub End If MyBmpInfo=1 y=y-5 Else If KeyCode=39 Then If x>=600 Then Exit Sub End If MyBmpInfo=3 x=x+5 Else If KeyCode=40 Then If y>=400 Then Exit Sub End If y=y+5 End If InvalidateRect(hMainWnd,ByVal 0,TRUE) End Sub と書きました。 すみませんが、どなたかご存知の方がいらっしゃいましたら、ご教授ください。 お願いします。

  • 日付の自動表示がうまくできません。

    VBAを使って、EXCELで日付を自動表示するマクロを作ったのですが、うまく動作しません。 設定の条件は、(対象の行は6~31行目で) D列に入力があった場合、G列に日付を表示、 M列に入力があった場合、N列に日付と時間を表示 です。 Private Sub Worksheet_Change(ByVal Target As Range) Dim r As Integer, c As Integer 'r 行番号 'C 列番号 r = Target.Row c = Target.Column If Target.Count > 1 Then Exit Sub If c <> 13 Or r < 6 Or r > 31 Then End If Cells(r, c) <> "" Then If c = 13 Then Cells(r, c + 1) = Format(Now, "m/d hh:mm") Else Cells(r, c + 1) = "" End If If Target.Count > 1 Then Exit Sub If c <> 4 Or r < 6 Or r > 31 Then End If Cells(r, c) <> "" Then If c = 4 Then Cells(r, c + 3) = Format(Now, "m/d hh:mm") Else Cells(r, c + 3) = "" End If End Sub 作っているうちに、どこがおかしいのかわからなくなってしまいました。 助けて頂ければと思います。

  • fortran if文

    以下のコードで、xとthetaに5,5と入力しても、出力が5となってしまいます。500になってほしかったんですが・・・ どこが悪いのか教えて下さい。 ----------------------------------------------- read(5,*)x,theta if(0.0d0.LE.x.LE.4.0d0) then eta=theta go to 20 else if(4.0d0.LT.x.LT.7.0d0) then eta=100.0d0*theta go to 20 else if(7.0d0.LE.x.LE.10.0d0) then eta=sqrt(3.0d0*sqrt(2.0d0))*theta go to 20 end if 20 write(6,30) eta 30 format(F10.5) stop end -----------------------------------

  • 窓口負担金の計算方法について

    医療事務に詳しい方質問お願いします。 私は歯科医院に勤めているのですが窓口負担金の計算方法に不安があります。 例えば合計点数が641点の場合、3割負担の方は1923点で1の位は四捨五入のため1920円が負担金になりますよね?残りの7割分は4487点で1の位四捨五入のため4490円分をレセプトで保険先に請求して、6410円分全てが請求出来たことになりますよね? 問題は1の位が5となった場合。例えば合計点数が1005点この場合全額であれば10050円です。3割負担で3015点、四捨五入で3020円が負担金です。残り7割は7035点、四捨五入で7040円をレセプトで請求します。ここで両方を足すと10060円になってしまい、合計が合いません。 1の位が5になった場合どのようになるのでしょうか?

  • ▲ExcelのVBA▼困っています

    何度もVBAで質問させてもらい助けてもらっています。 懲りずにまた質問ですが… 下のプログラムは"●"が跳ね返るものなのですが… ●の後を■と▲が追うようなプログラムにするには なにを追加すればいいのでしょうか…?; どなたか教えて下さい;;お願いします;; Dim time1 As Integer, time As Integer Dim X As Integer, Y As Integer Dim maru As String, yoko As String, tate As String Sub 描画() Cells(X, Y).Value = maru End Sub Sub 削除() Cells(X, Y).Value = "" End Sub Sub 待機() For time1 = 0 To 1000 For time2 = 0 To 1000 Next Next End Sub Sub 座標移動() If yoko = "右" Then Y = Y + 1 Else Y = Y - 1 End If If Y = 30 Then yoko = "左" ElseIf Y = 1 Then yoko = "右" End If If tate = "上" Then X = X + 1 Else X = X - 1 End If If X = 20 Then tate = "下" ElseIf X = 1 Then tate = "上" End If End Sub Sub main() maru = "●" X = 1 Y = 1 yoko = "右" tate = "上" Do 描画 待機 削除 待機 座標移動 Loop End Sub