Excel VBA質問箱 IV

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

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


44716 / 76732 ←次へ | 前へ→

【37028】Re:同型のフォームで似たような処理・・・・
質問  もんこち  - 06/4/19(水) 22:56 -

引用なし
パスワード
    レスありがとうございます。

フォームが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


フォームによって'=選択された項目の名前・単価・単位を表示する=の部分ひっぱってくるセル位置やセルに転記する場所が少し違うだけなので全部のシートにずらずらーっと書くのは無駄だなぁと思ったんです。
クラス化は必要ないのかもしれないですが、今後のために覚えたいという気持ちもあります・・・
よろしくお願いします。

6 hits

【36945】同型のフォームで似たような処理・・・・ もんこち 06/4/18(火) 19:24 質問
【36959】Re:同型のフォームで似たような処理・・・・ ichinose 06/4/19(水) 8:54 発言
【37028】Re:同型のフォームで似たような処理・・・・ もんこち 06/4/19(水) 22:56 質問
【37040】Re:同型のフォームで似たような処理・・・・ ichinose 06/4/20(木) 8:21 発言
【37075】Re:同型のフォームで似たような処理・・・・ もんこち 06/4/20(木) 20:28 質問
【37083】Re:同型のフォームで似たような処理・・・・ ichinose 06/4/20(木) 22:55 発言

44716 / 76732 ←次へ | 前へ→
ページ:  ┃  記事番号:
2610219
(SS)C-BOARD v3.8 is Free