Excel VBA質問箱 IV

当質問箱は、有志のボランティア精神のおかげで成り立っています。
問題が解決したら、必ずお礼をしましょうね。
本サイトの基本方針をまとめました。こちら をご一読ください。

投稿種別の選択が必要です。ご注意ください。
迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。

  新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃過去ログ ┃ホーム  
6188 / 13646 ﾂﾘｰ ←次へ　｜　前へ→
▼ 【46720】重さの範囲設定 MIKAMI 07/2/13(火) 11:01 質問[未読]
【46723】Re:重さの範囲設定 りん＠とおりすがり 07/2/13(火) 12:12 回答[未読]
【46725】Re:重さの範囲設定 Jaka 07/2/13(火) 12:30 質問[未読]
【46726】Re:重さの範囲設定 Jaka 07/2/13(火) 12:37 発言[未読]
【46730】修正 Jaka 07/2/13(火) 13:27 発言[未読]
【46729】Re:重さの範囲設定 MIKAMI 07/2/13(火) 13:19 お礼[未読]
【46720】重さの範囲設定
質問  MIKAMI  - 07/2/13(火) 11:01 -
引用なし
パスワード
   　　A1　　B1　　　　C1
　　10　KGまで　　1000円
　　20　KGまで　　2000円
　　30　KGまで　　3000円
　　40　KGまで　　4000円

という表をシートに記載してあります。

ユーザーフォームのコマンドボタンを押すと

Private Sub CommandButton1_Click()

If TextBox1.Value <> "" Then　***貨物の大きさが入力されたら
　With Worksheets("セット")　　***セットのワークシートから
　Set foundcell = .Range("A1:A5000").Find(TextBox1.Value)　***貨物の大きさをA1からA5000の中からみつける。　
　If foundcell Is Nothing Then　***みつからない場合は
　　MsgBox "料金確認不可"　　***料金確認不可と表示
　
　Else
　　myR = "Q" & foundcell.Row　****見つかったら
　　TextBox1.Value = .Range(myR).Offset(0, 2).Value　****みつかったらその数字のセルまで飛ぶ
　　
End If
End With
End If
End Sub

TextBox1.Value = .Range(myR).Offset(0, 2).Value　****みつかったらその数字のセルまで飛ぶ
お分かりのとおり、これだと指定した重さの数字しか見つけることができません。
0〜10KGは1000円　11〜20KGは2000円　21〜30KGは3000円。。。と設定したいのですが。。
初心者で言葉足らずがあり、わかりづらいかと思いますがどうぞご指導お願いします。
【46723】Re:重さの範囲設定
回答  りん＠とおりすがり  - 07/2/13(火) 12:12 -
引用なし
パスワード
   ▼MIKAMI さん：
>　　A1　　B1　　　　C1
>　　10　KGまで　　1000円
>　　20　KGまで　　2000円
>　　30　KGまで　　3000円
>　　40　KGまで　　4000円
>
>という表をシートに記載してあります。

リストどおりにならんでるとして、セルの値が超えたかどうかをチェックします。
Private Sub CommandButton1_Click()
　 Dim dt As Currency, rr As Long, rmax As Long, Rpos As Long
　 Dim ws As Worksheet
　 '
　 Set ws = Application.ThisWorkbook.Worksheets("セット")
　 dt = Val(Me.TextBox1.Value)
　 rmax = ws.Range("A10000").End(xlUp).Row
　 If dt = 0 Then
　　　MsgBox "重量を指定してください", vbExclamation
　 Else
　　　For rr = 1 To rmax
　　　　 If ws.Cells(rr, 1).Value >= dt Then
　　　　　　Rpos = rr: Exit For
　　　　 End If
　　　Next
　　　If Rpos = 0 Then
　　　　 MsgBox "料金確認不可", vbExclamation, dt & "kg"
　　　Else
　　　　 MsgBox "料金は、" & Format(ws.Cells(Rpos, 3), "#,##0") & "円です", vbInformation, dt & "kg"
　　　End If
　 End If
End Sub

こんな感じです。
【46725】Re:重さの範囲設定
質問  Jaka  - 07/2/13(火) 12:30 -
引用なし
パスワード
   Private Sub CommandButton1_Click()
Dim 数値 As Long, FF As Variant
数値 = Application.Ceiling(TextBox1.Value, 10)
With Worksheets("セット")
　FF = Application.Match(数値, .Columns(1), 1)
　If IsError(FF) Then
　　 MsgBox "ない"
　Else
　　 TextBox1.Value = .Cells(FF, 3).Value
　End If
End With
End Sub
【46726】Re:重さの範囲設定
発言  Jaka  - 07/2/13(火) 12:37 -
引用なし
パスワード
   >　FF = Application.Match(数値, .Columns(1), 1)
これでもよかった。
FF = Application.Match(数値, .Columns(1), 0)

さらに上のスレッドのついて、下記をコピペし忘れました。

細かいエラーチェックは入れてません。
必要に応じて追加してください。
【46729】Re:重さの範囲設定
お礼  MIKAMI  - 07/2/13(火) 13:19 -
引用なし
パスワード
   りんさん、JAKAさんありがとうございました！！
大変参考になりました♪
【46730】修正
発言  Jaka  - 07/2/13(火) 13:27 -
引用なし
パスワード
   >>　FF = Application.Match(数値, .Columns(1), 1)
>これでもよかった。
>FF = Application.Match(数値, .Columns(1), 0)
今頃ですが...。
これでも、というよりこっちにしてください。
  新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃過去ログ ┃ホーム  
6188 / 13646 ﾂﾘｰ ←次へ　｜　前へ→
ページ：  ┃  記事番号：
2610219
(SS)C-BOARD v3.8 is Free