| |
いきなりですが、ツール→オプションで「変数の宣言を強制する」をON
にすることを強くお勧めします。
なので、デバッグするのが面倒でソースはチラッとしか見てません。
チラッと見てわけがわからんかったので、作成しました。
なお、終わってみてみたらFunction Gakuでの判断が希望のものと
違うようなので、跡で適当に変更してください。
・最低必要限しか書いてません。（実用は問題あり）
・判り易いように特別な手法は使わず、力技で検索してます。
目的
基準額､会員か否かを判断して､割引率を取得する
目で表を見たときどういう風に頭で処理しているか (Excelは関係ない)
を整理する
１．検索する額と､会員か否かの情報を取得する
２．検索する額を元に基準額を探す
３．該当する基準額の行で、一般、会員を探し、割引率を取得する
４．割引率を返す
ここまでが頭の中で行う作業
ToShiYoさんのコードを見ていると↑が全く整理されていないように見える
弊害：いきなりコード化すると頭がこんがらかって間違いやすい。
半年後の自分は他人と同じです。たぶんこのソースでは全く
わけがわからないでしょう。（メンテナンス出来ない。）
又、最低限必要なコメントは付けましょう。
訳がわからん。解読が面倒です。
ここでExcelで考えてみる
最初にUPしていた表を使って作成してます。
GetWaribikiがメインプログラムです。
Sub GetWaribiki()
Dim kingaku As Long '検索する額
Dim Kijyun As Long '基準金額
Dim blnkaiin As Boolean 'TRUE：会員、FALSE：一般
Dim lRow As Long '行番号
Dim Waribiki As Single '割引率
Dim sBuf As String
' 1 ､検索する額と､会員か否かの情報を取得する
kingaku = CLng(InputBox("検索する額を入力して下さい。", "Test"))
blnkaiin = CBool(InputBox("会員ですか？" & vbCrLf & "会員の場合１" & vbCrLf _
& "一般の場合０" & vbCrLf & "を入力して下さい。", "Test"))
'２．検索する額を元に基準額を探す
kingaku = Gaku(kingaku)
'３．該当する基準額の行で、一般、会員を探し、割引率を取得する
' 3-1会員か、一般化を文字列化
If blnkaiin = True Then
sBuf = "会員"
Else
sBuf = "会員"
End If
'3-2 該当する基準額の行で、一般、会員を探し、割引率を取得する
Waribiki = SearchKingaku(Worksheets("Sheet1"), kingaku, blnkaiin)
MsgBox kingaku & "の割引率は" & vbCrLf & sBuf & "割引で" & vbCrLf & _
Waribiki * 100 & "%" & vbCrLf & " です。"
End Sub
Private Function Gaku(pKingaku As Long) As Long
'２．検索する額を元に基準額を探す
Select Case pKingaku
Case Is < 10000
Gaku = 10000
Case Is < 20000
Gaku = 20000
Case Is < 50000
Gaku = 50000
End Select
End Function
Private Function SearchKingaku(pSheet As Worksheet, pKingaku As Long, pKaiin As Boolean) As Single
'３．該当する基準額の行で、一般、会員を探し、割引率を取得する
'////////////////////////////////////////////////////////
'引数
'pSheet :シートオブジェクト
'pKingaku ：検索する金額
'pKaiin :TRUE：会員、FALSE：一般
'/////////////////////////////////////////////////////////
Const cSeachRow As Long = 1 '１列目(A列）を探す
Dim lColumuOffset As Long '検索する行
Dim sTarget As String
Dim I As Long, IMax As Long
Dim lRet As Single '戻り値
lRet = 0
If pKaiin = True Then
lColumuOffset = 3 '会員
Else
lColumuOffset = 2 '一般
End If
' 該当する基準額の行を検索する
With pSheet
IMax = pSheet.Cells(pSheet.Cells.Rows.Count, 1).End(xlUp).Row
sTarget = CStr(pKingaku) & "円以上"
For I = 2 To IMax
If .Cells(I, cSeachRow).Value = sTarget Then '行が見つかった
'割引率を返す
lRet = .Cells(I, lColumuOffset).Value
Debug.Print .Cells(I, lColumuOffset).Value
Exit For
End If
Next I
End With
SearchKingaku = lRet
End Function
※質問は受け付けますが、改造はお断りします。
|
|
![[未読]](./data/excel/image/read_icon.gif){kind=icon}
