[VBA] IFと絶対値の組み合わせ
- テキストボックスを利用して計算する際に、IF文と絶対値を組み合わせて条件を設定する方法について質問しています。
- テキストボックスに入力された数値に基づいて計算を行う際に、D1とD2の値によって条件分岐をする必要がある場合、絶対値を使って条件を正確に設定することができます。
- しかし、現在のコードでは絶対値の比較が不正確になってしまっているようです。より適切な構文や条件の設定方法についてアドバイスを求めています。
- ベストアンサー
[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として計算している？） 何かよい構文はありませんでしょうか？
- ryo_ky
- お礼率100% (10/10)
- その他MS Office製品
- 回答数1
- ありがとう数1
- みんなの回答 （1）
- 専門家の回答
質問者が選んだベストアンサー
ryo_ky さん、こんばんわ Abs(D2)は、正負が分からない変数に対して確実に正の値を取りたい時に利用すると便利です。 今回はD2が負であることが分かっているので（というかそのように条件分岐をしているので）、「-D2」と表記するか、「D2 * (-1)」と表記すれば良いですね。 ただし、そのように書いても問題は解決しないかもしれません。 私が同様な条件にて試してみたところ、問題なく条件分岐に成功しましたので、むしろ実際にD1、D2にどのような値が代入されているか、リアルタイムで確認する必要があるのではないでしょうか。 ソースの If Abs(D2) > D1 Then の行にカーソルを合わせ、F9キーを押してください。その行が茶色に着色されると共に、行頭に茶色の●が表示されるはずです。 この状態でプログラムを実行させると、その位置で実行が一時停止されます。 その状態で、Abs(D2) にカーソルを合わせてみてください。現在のAbs(D2)の値が表示されます。また、D1にもカーソルを合わせてみてください。D1の値が表示されます。この2つの値を実際に見比べてみてください。ひょっとしたらD1とD2の大小関係について、ryo_kyさんが想定していた値とは別の値が入っているかもしれませんよ。 途中で止めることができない場合（このソースでは無いとは思いますが）、「Debug.print」を利用します。 If Abs(D2) > D1 Then の上の行に、以下の2行を追加します。 Debug.Print "D1=" & D1 Debug.Print "Abs(D2)=" & Abs(D2) その上で、Visual Basic Editor から、「表示(V)」－「イミディエイト ウィンドウ」を選んでもらうか、Ctrlキーを押しながらGを押して、イミディエイトウィンドウを開きます。 その状態で実行すれば、D1とAbs(D2)の結果がイミディエイトウィンドウに表示されます。 それで一度値を確認してみてください。
関連するQ&A
- VBAでelseに対応するifがありませんとエラー
VBA初心者です 入力した数値（0から5）により、呼んでくる列を変えたいマクロを組んでいます if then elseif end ifで条件式を作ったのですが、 「elseに対応するifがありません」とエラーが出て進みません elseifが悪いのかと思い、条件を1つに絞ると上手く動きます（この際はendifは不要） ネット検索や参考書を見てますが、分かりません どなたか間違いを指摘して頂けませんか？ Sub inputboxA() Dim nDat As String nDat = inputbox("何ヶ月目ですか？") If IsNumeric(nDat) = False Then MsgBox ("0から5までの値を入力して下さい") Exit Sub End If If nDat = 0 Then mm = 16 '0なら16列からデータを呼んでくる ElseIf nDat = 1 Then mm = 20 'ここでエラーが出る 1なら20列目からデータを呼んでくる ElseIf nDat = 2 Then mm = 24 '2なら24列目からデータを呼んでくる ElseIf nDat = 3 Then mm = 28 '3なら28列目からデータを呼んでくる ElseIf nDat = 4 Then mm = 32 '4なら32列目からデータを呼んでくる ElseIf nDat = 5 Then mm = 36 '5なら36列目からデータを呼んでくる End If 'データを呼んでくる For r = 4 To 2000 '処理するSheet1の行数範囲 b = Sheets(1).Cells(r, 1) 'bにA列の値を代入 For t = 6 To 2000 '検索するSheet3の行数範囲 If Sheets(3).Cells(t, 7) = b Then 'Sheet1のA列の値とSheet3のA列が一致した場合 y = Sheets(3).Cells(t, mm) 'yにB列の値を代入 Sheets(1).Cells(r, 6).Value = y 'Sheet1のB列に値を入力 Exit For '値が見つかったのでForを終了 End If Next Next End Sub
- 締切済み
- その他MS Office製品
- このVBAソースのどこが間違ってるか教えてください
Dim csp As Integer 'ストップ Dim css As Integer 'ストップorスタート Sub Quest2() If css = 0 Then css = 1 Quest2a Else cstp = 1 css = 0 End If End Sub Sub Quest2a() Sheets("Sheet1").Select Range("B1:J10").Select Selection.Interior.ColorIndex = x1None Range("a1").Select cstp = 0 Do r = 1: c = 5 For i = 0 To 15 If i < 9 Then Cells(r, c).Interior.ColorIndex = x1None r = r + 1 If i < 5 Then c = c + 1 Else c = c - 1 End If Cells(r, c).Interior.ColorIndex = 3 Else Cells(r, c).Interior.ColorIndex = x1None r = r - 1 If i < 13 Then c = c - 1 Else c = c + 1 End If Cells().Interior.ColorIndex = 3 End If 'タイミング For tm1 = 1 To 1000: For tm2 = 1 To 100: Next If cstp = 1 Then Exit For End If Next DoEvents If cstp = 1 Then Exit For End If If r = 3 And c = 5 Then Cells(r, c).Interior.ColorIndex = x1None End If Next DoEvents If cstp = 1 Then Exit Do End If Loop Cells(10, 9) = Cells(r, c) Cells(10, 9).Interior.ColorIndex = 8 End Sub
- ベストアンサー
- その他（プログラミング・開発）
- Excel2010 VBA 条件色付け
Sub sample() Dim r As Range For Each r In Range("q6:q30") If myIsNumeric(r) Then r.Offset(0, 1).Value = "数字" Else r.Offset(0, 1).Value = "文字" End If Next End Sub Function myIsNumeric(Target As Range) Dim r As Range Dim buf, tmp Dim flg As Boolean Dim i As Integer buf = Target For i = 1 To Len(buf) tmp = Mid(buf, i, 1) If IsNumeric(tmp) Then flg = True Exit For End If Next myIsNumeric = flg End Function を数字が入ってたら塗りつぶさないで、 数字が入ってなかったら塗りつぶすように直したいです。 あああ→塗る あああ1－1→塗らない 住所→塗る 住所12→塗らない
- ベストアンサー
- Excel（エクセル）
- ユーザー定義関数の構文がわからない
以下のコードがあるのですが、コメントがなくて意味がよくわかりません。k = p(1),n = Application.Count(p),t = Sgn(position)というあたりがいきなり見たことのない構文で戸惑ってます。 インターネットでも調べようがありませんでした。 どなたか下のコードにコメントを入れてくれませんでしょうか？ちなみに株式売買のシミュレーション用の関数です。 Function Positioning(position As Single, x As Single, y As Single, p As Range) Dim k As Single, t As Single, r As Single Dim n As Integer, i As Integer If position = 0 Then Positioning = "": Exit Function k = p(1) n = Application.Count(p) t = Sgn(position) If t > 0 Then l = Abs(x): m = -Abs(y) Else l = Abs(y): m = -Abs(x) End If For i = 2 To n r = (p(i) / k - 1) * t If r >= l Or r <= m Then t = 0: Exit For Next If t = 0 Then Positioning = r Else Positioning = "ポジションは解消されていません" End If End Function
- ベストアンサー
- オフィス系ソフト
- VBAで教えてください。
データがないときはExitSubしたいのですが、何処に記述すれば良いでしょうか？ Sub 削除() Dim i As Long If MsgBox("データを削除します。よろしいですか？", vbYesNo) = vbYes Then Sheets("リスト").Select i = 5 Do Until i = 200 If Cells(i, 5).Value = Sheets("マスタ登録").Range("D5") Then Cells(i, 1).EntireRow.Delete End If i = i + 1 Loop Else Exit Sub End If End Sub
- ベストアンサー
- オフィス系ソフト
- マクロにおける条件文の作成の件
以下の様に条件付きの計算式を作成しました。CommandButton3を押しても 計算しなかったり、TextBox3.Value > TextBox1 ではないときでもエラー メッセージが出ます。どこに欠点があるのか教えて下さい。 Private Sub CommandButton3_Click() Dim row As Integer If TextBox1.Value = Empty Then MsgBox ("Ａが空欄です") Exit Sub End If If TextBox2.Value = Empty Then MsgBox ("Ｂが空欄です") Exit Sub End If If TextBox3.Value = Empty Then MsgBox ("Ｃが空欄です") Exit Sub End If If TextBox4.Value = Empty Then MsgBox ("Ｄが空欄です") Exit Sub End If If TextBox3.Value > TextBox1.Value Then MsgBox ("Ｃの値をＡの値より小さくしましょう！") Exit Sub End If If TextBox4.Value > TextBox2.Value Then MsgBox ("Ｄの値をＢの値より小さくしましょう！") Exit Sub End If TextBox5 = Round(TextBox1 * TextBox2 - (TextBox1 - TextBox3) * (TextBox2 - TextBox4) / 2, 0) End Sub
- ベストアンサー
- オフィス系ソフト
- 印刷後のVBAの実行 (3)
Private Sub Workbook_BeforePrint(Cancel As Boolean) If ActiveSheet.Name = "Sheet1" Then If Range("D6").Value = "" Then Cancel = True MsgBox ("名前を入力してください") Range("D6").Select Exit Sub End If Else If ActiveSheet.Name = "Sheet2" Then If Range("C11").Value = "" Then Cancel = True MsgBox ("受付時間を入力してください") Range("C11").Select Exit Sub End If Else Exit Sub End If End If If Worksheets("Sheet1").Range("D5") = "不要" Then GoTo P1 ActiveSheet.Range("A70:Y70").Copy If Worksheets("Sheet3").Range("A1").Value = "" Then Worksheets("Sheet3").Range("A1").PasteSpecial Paste:=xlPasteValues Else Worksheets("Sheet3").Range("A65536").End(xlUp).Offset(1, 0).PasteSpecial _ Paste:=xlPasteValues End If Application.CutCopyMode = False P1: ActiveSheet.Range("A1").Select End Sub sheet1のD5に「不要」と入っていたら 24～33行目の作業がキャンセルになりますが sheet2のD5にも「不要」と入っていたら、同じ様にキャンセルできる様に出来ますでしょうか？ ご回答お願いします
- 締切済み
- オフィス系ソフト
- IFステートメントの使い方 どちらでもないならば
「出金も入金も0じゃないならば」としたい場合、どのようなifステートメントを作ればいいでしょう？ Sub test() Dim 出金 As Currency Dim 入金 As Currency 出金 = 0 入金 = 0 '(1) If Not (出金 = 0) And Not (入金 = 0) Then MsgBox "出金0入金0ではありません" End If '(2) If (出金 = 0) And (入金 = 0) Then Else MsgBox "出金0入金0ではありません" End If End Sub (1)だとうまくいきません。 (2)のように Elseを使って対応するしかないのでしょうか？ (2)でいけますが、今後の勉強の為にelseを使わずに、「どちらでもないならば」の方法を教えてください。
- ベストアンサー
- オフィス系ソフト
- 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
- 締切済み
- その他(データベース)
- ExitでIFステートメントを抜けたい
Sub test() Dim n As Byte, i As Byte For i = 0 To 5 If n = 0 Then n = n + 1 Else Exit For '（1）ここから End If i = i + 1 '（2）ここへ来たい（ＩＦステートメントだけ抜けたい） Next i End Sub のように（1）から（2）へ行きたいのですが このコードを実行すると Forステートメントを抜けてしまい、マクロが終了してしまいます。 「Exit If」にするとエラーになってしまいます。 Exitを使用してIFステートメントだけ抜け、 Forステートメントに戻るにはどうすればいいでしょうか？ ご教授よろしくお願いします。
- ベストアンサー
- オフィス系ソフト
お礼
ご回答有難うございます。返事が遅くなりまして申し訳ございません。 値を確認しましたところ、 D1="5" D2="-10" Abs(D2)=10 となりまして、10と"5"の比較になった事が問題の様です。 "数値"と数値での違いについては、まだ調べていませんので、良く分かりませんが、 構文を If Abs(D2) > Abs(D1) Then （両方とも絶対値）にする事で解決致しました。 F9で○が付く事は知っていましたが、これが式を途中で止める事とは知りませんでした。 重ねて御礼を申し上げます。