| |
お世話になります。
薬剤DBﾀﾌﾞを作成して
A検索文字 B単位（錠、カプセルなど）Cジェネリック D先発薬剤
フォームにﾃｷｽﾄBoxと検索ボタンを作成
候補を3行listboxで作成し
下2行にジェネリック、先発を反映させるところまではうまく行きました。
*************************************************************************
'検索を実行します。部分一致検索を行っています。
Private Sub cmdSearch_Click()
Dim lastRow As Long
Dim myData, myData2(), myData3(), myData4(), myno
Dim i As Long, j As Long, cn As Long
' If M_serch.Value = "" ThenEnd
'検索するデータを配列 myData に格納しています。
With Worksheets("薬剤DB50音順")
lastRow = .Cells(Rows.Count, 1).End(xlUp).Row
myData = .Range(.Cells(1, 1), .Cells(lastRow, 4)).Value
End With
'配列 myData の中で検索で一致したデータを配列 myData2 に格納しています。
ReDim myData2(1 To lastRow, 1 To 3)
ReDim myData3(1 To lastRow, 1 To 2)
ReDim myData4(1 To lastRow, 1 To 2)
For i = LBound(myData) To UBound(myData)
If myData(i, 1) Like "*" & M_serch.Value & "*" Then
cn = cn + 1
myData2(cn, 1) = myData(i, 1)
myData2(cn, 2) = myData(i, 3)
myData2(cn, 3) = myData(i, 2)
If myData(i, 3) <> "" Then
cn2 = cn2 + 1
myData3(cn2, 1) = myData(i, 3)
myData3(cn2, 2) = myData(i, 2)
If myData(i, 3) <> "" Then
cn2 = cn2 + 1
myData4(cn2, 1) = myData(i, 4)
myData4(cn2, 2) = myData(i, 2)
End If
End If
End If
Next i
'検索で一致したデータを先発リストボックスに表示します。
With lstResult_M1
.ColumnCount = 3
.ColumnWidths = "140;105;20"
.List = myData2
End With
'検索で一致したデータを後発リストボックスに表示します。
With lstResult_new
.ColumnCount = 2
.ColumnWidths = "180;20"
.List = myData3
End With
'検索で一致したデータを後発リストボックスに表示します。
With lstResult_new2
.ColumnCount = 2
.ColumnWidths = "180;20"
.List = myData4
End With
End Sub
*********************************************************************
伺いたいのは
ここで反映した候補の薬剤を
1.リスト選択、ただしジェネリックか先発どちらかしか選べない
2.フォームには数値入力のTextBoxと実行ボタンがあり
選択したセルがアクティブセルで K4だとした場合(別ﾀﾌﾞになります。)
K4セルを捕まえて実行ボタンを押すと
K4（薬剤名）K5（数値 1.2など）K6（単位 錠、カプセルなど）
と繁栄をさせたいのですが
そもそもアクティブセルを反映させる段階でうまく行きません
****************************************
Private Sub cmdMakeStatus_Click()
Dim lRow As Long, i As Long
Dim ListNo As Long
ListNo = lstResult_new.ListIndex
If ListNo < 0 Then
MsgBox "いずれかの行を選択してください"
Exit Sub
End If
With Worksheets("処 方 録")
lRow = .Range("B" & Rows.Count).End(xlUp).Row
'For i = 0 To 2
.ActiveCell.Value = lstResult_new.List(ListNo, i)
'Next i
.ActiveCell.Offset(0, 2).Value = lstResult_new.List(ListNo, i + 1)
End With
Ent_figure01.Value = ""
lstResult_new.TopIndex = ListNo
End Sub
**************************************************************
正直どこで間違えているかも分からない状況です。
ご教示よろしくお願い致します。
|
|
ノボル
- 21/12/2(木) 19:57 -
トム
- 21/10/5(火) 6:44 -
山内
- 21/10/4(月) 13:14 -
ken
- 21/10/3(日) 12:08 -
