Excel VBA質問箱 IV

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

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


44667 / 76735 ←次へ | 前へ→

【37083】Re:同型のフォームで似たような処理・・・・
発言  ichinose  - 06/4/20(木) 22:55 -

引用なし
パスワード
   ▼もんこち さん:
こんばんは。


>4つのフォームでコードが変わる部分ですが、
>
>「オートフィルタを使ってリストへ候補表示」の部分では、オートフィルタをかける対象のシート

ということは、

>  Set wsDrugMaster = wbOwn.Worksheets("商品マスター")

このシート名の箇所ですね?


>「'選択された医薬品の単価をTB2へ(小数点第2位を四捨五入)」では横方向にoffsetする数

これは、
>    wsSlip.Cells(7, "BH") = rgKana.Offset(0, 4) / rgKana.Offset(0, 2)
      
     
>    strUnit = rgKana.Offset(0, 3)
この2行の
  rgKana.Offset(0, 4) の4
  rgKana.Offset(0, 2) の2
及び、
  rgKana.Offset(0, 3) の3

がフォームによって値が変わると言うことですね?

ということは、

フォームを表示するときに

shtnm String型 ---  作業を行うシート名

値ををセットする列識別番号として
 IndexA Long型 ----例の4の値を格納する変数
 IndexB Long型 ----例の2の値を格納する変数
 IndexC Long型 ----例の3の値を格納する変数


この情報を送ることが出来ればフォームは一つにまとめられますね?


>フォームが4つ(frmBaika,frmNounyuuka,frmRevBaika,frmRevNounyuu)ありまして、すべてのフォームで以下のようなコードを書いています。

ユーザーフォームは、frmとします(実際には、わかりやすい名前にして下さい)。


frmのモジュールには、
'=================================================================
public shtnm as string '---  作業を行うシート名
public IndexA as long '---  例の4の値を格納する変数
public IndexB as long '---  例の2の値を格納する変数
public IndexC as long '---  例の3の値を格納する変数

'=======================================
>Private Sub TextBox1_Exit(ByVal Cancel As MSForms.ReturnBoolean)
>
>
>Application.ScreenUpdating = False
> 
> 
>  '=オブジェクト変数のセット=
>  Set wbOwn = ThisWorkbook
  Set wsDrugMaster = wbOwn.Worksheets(shtnm)
>  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, IndexA) / rgKana.Offset(0, IndexB)
>      
>      dblCost = wsSlip.Cells(7, "BI").Value
>      
      strUnit = rgKana.Offset(0, IndexC)
>      
>      '=選択された項目の名前・単価・単位を表示する=
>      Label12.Caption = strDrugName         
>      
>      Label9.Caption = strUnit
>      
>      TextBox2.Value = Format(dblCost, "#,##0.00")
>        
>    End If
>  
>  Next rgKana
>    
>
>End Sub


とします。


このフォームを呼び出すプロシジャーでは、
例えば、
sub main()
  load frm
  with frm
    .shtnm="商品マスター"
    .IndexA=4
    .IndexB=2
    .IndexC=3
    .show
    end with
end sub

と記述すれば、

作業シート名として"商品マスター"

Offset値として、4,2,3という値で処理がなされます。

処理する内容によって、shtnmやIndexA〜IndexCの値を変更して、
表示すればよいですよね?

尚、IndexA〜IndexCに関しては規則性があるばならば、
一つで足りるかもしれません。

また、記述された箇所以外にも値が変わる箇所があった場合は
同じようにフォームのPublic変数として宣言して
表示(Showメソッド)前にデータを設定することで
処理できると思います。

試してみてください。
0 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 発言

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