| |
▼ichinose さん：
こんばんわ。
うまく説明ができなくて申し訳ありません
4つのフォームでコードが変わる部分ですが、
「オートフィルタを使ってリストへ候補表示」の部分では、オートフィルタをかける対象のシート
「'選択された医薬品の単価をTB2へ(小数点第2位を四捨五入)」では横方向にoffsetする数
の2点が異なるのでフォームが４つと4種類のコードをそれぞれ記述しています・・・。
フォームの形状、コントロール数は全く同じです。
レスありがとうございます。
フォームが4つ（frmBaika,frmNounyuuka,frmRevBaika,frmRevNounyuu)ありまして、すべてのフォームで以下のようなコードを書いています。
'==========================================================================
'=オートフィルタを使ってリストへ候補表示=======================================
Private Sub TextBox1_Exit(ByVal Cancel As MSForms.ReturnBoolean)
Application.ScreenUpdating = False
'=オブジェクト変数のセット=
Set wbOwn = ThisWorkbook
Set wsDrugMaster = wbOwn.Worksheets("商品マスター")
Set wsSlip = wbOwn.Worksheets("伝票")
'=検索キーが空白の時は何もしない=
If TextBox1 = "" Then
Exit Sub
End If
'=検索キーでオートフィルターを実行し結果をリストボックスに表示する=
wsDrugMaster.Activate
strDrugName = TextBox1.Value
wsDrugMaster.Cells(1, "A").AutoFilter
wsDrugMaster.Columns("HD:HD").Clear
wsDrugMaster.Cells(1, "A").AutoFilter Field:=1, Criteria1:="=" & strDrugName & "*"
wsDrugMaster.Range(wsDrugMaster.Cells(2, "B"), wsDrugMaster.Cells(2, "B").End(xlDown)).Copy
wsDrugMaster.Cells(2, "HD").PasteSpecial
ListBox1.List = wsDrugMaster.Range(wsDrugMaster.Cells(2, "HD"), _
wsDrugMaster.Cells(2, "HD").End(xlDown)).Value
Application.CutCopyMode = False
'="伝票"シートに戻る=
wsSlip.Select
Range("A1").Select
'=リストボックスの最初の項目を選択=
ListBox1.ListIndex = 0
Application.ScreenUpdating = True
End Sub
'==============================================================================
'選択された医薬品の単価をTB2へ(小数点第2位を四捨五入)==========================
'==============================================================================
Private Sub ListBox1_Click()
'=変数の宣言=
Dim rgDrugPhonetic As Range '"商品マスター"シート半角カナ列（検索範囲）
Dim rgKana As Range
'=オブジェクト変数のセット=
Set rgDrugPhonetic = wsDrugMaster.Range(wsDrugMaster.Cells(2, "B"), _
wsDrugMaster.Cells(2, "B").End(xlDown))
Set wsSlip = wbOwn.Worksheets("伝票")
'=項目が選択されていない場合はなにもしない=
strDrugName = ListBox1.Value
If strDrugName = "" Then
Exit Sub
End If
'=選択された項目名をキーに単価・単位（購入価／薬価倍率）を取得する=
For Each rgKana In rgDrugPhonetic
If rgKana.Value = strDrugName Then
wsSlip.Cells(7, "BH") = rgKana.Offset(0, 4) / rgKana.Offset(0, 2)
dblCost = wsSlip.Cells(7, "BI").Value
strUnit = rgKana.Offset(0, 3)
'=選択された項目の名前・単価・単位を表示する=
Label12.Caption = strDrugName
Label9.Caption = strUnit
TextBox2.Value = Format(dblCost, "#,##0.00")
End If
Next rgKana
End Sub
|
|
もんこち
- 06/4/20(木) 20:28 -
