新旧薬価対比表に検索機能をもたせるマクロがめっちゃ便利！全薬局が導入すべき！

どうも暇人薬剤師のヤクタマです。

今回はネットで拾った新旧薬価の比較表に検索機能をもたせるマクロの紹介です。

新旧薬価の比較表はネットに落ちてるんだけど、ただの一覧表だからいかんせん使いにくいのよね。

やっぱ検索機能がほしいよね。

だって、比較表って何に使います？この医薬品を発注するしようか、でもこれは値下がるの？値上がるの？来月に発注もちこした方がいいの？的な判断材料に使いますよね。

発注ごとに頻繁に調べなければいけないのにチマチマ表で調べてられるかよ。

エクセルの既存機能でCtrl＋Fってのがあるけど、この検索もイマイチであっちこっちのページに飛んでチマチマとした作業が必要なんだわ。

こうしたチマチマした感じではなくって、検索キーワードを含む行をズバッとまるっと全部表示して一発で完結するような機能が欲しいの。

まぁ、この時期にしか使わない消費期限２週間くらいのツールなんだけどさ、薬価は毎年変わるわけだから作り方覚えて毎年活用しようぜ。

では、行ってみよう。

まずは新旧薬価の比較表をゲットするところからです。これはファルマーケットってサイトで作られたものがあるので、それを使わせていただきました。比較表を一から作るのはめんどくさいから、あるものは活用していくスタンスで。

ちなみに今回のマクロは割と応用が効くので、なんの一覧表でも使えます。

原理は、特定の「列」からキーワードを検索して、キーワードを含む行を新規シートに転記します。

たとえば「イグザレルト」って検索すると「イグザレルト」が含まれる行だけを抽出して新規シートに転記してくれます。

▼こんな感じね。

ダウンロードした一覧表に検索マクロをぶち込んであげるだけなので、簡単に実行できるはずです。

注意点なんだけど、もしファルマーケットさんのを使うなら最初の３行は消してください。一覧表の１行目が見出し行になるようにしてください。

「薬品名」の列で検索するためには「薬品名」が３列目になるように配置してください。いらない列は削除してもいいけど３列目が「薬品名」です。これは絶対ね。

別の列で検索かけたいならコードを読んでいじってくれ。

で、手っ取り早くコードはこちらです。

Sub 追加マクロ()
    Dim wsSource As Worksheet
    Dim wsNew As Worksheet
    Dim lastRow As Long, destRow As Long
    Dim keyword As String
    Dim i As Long
    
    ' キーワードを指定
    keyword = InputBox("検索するキーワードを入力してください", "キーワード入力")
    
    ' ソースシートを設定
    Set wsSource = ThisWorkbook.Sheets("令和6年度薬価比較表") ' 元データシートの名前を適宜変更
    
    ' 新しいシートを作成
    Set wsNew = ThisWorkbook.Sheets.Add(After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count))
    wsNew.Name = keyword ' シート名を適宜変更
    
    ' ソースシートの最終行を取得
    lastRow = wsSource.Cells(wsSource.Rows.Count, "A").End(xlUp).Row
    
    ' 新しいシートの最初の行にヘッダーをコピー
    wsSource.Rows(1).Copy wsNew.Rows(1)
    
    ' 新しいシートに行を追加
    destRow = 2 ' ヘッダーの次の行から開始
    For i = 2 To lastRow ' 2行目から最終行まで
        If InStr(1, wsSource.Cells(i, 3).Value, keyword) > 0 Then ' 3列目に品名が入っている場合
            wsSource.Rows(i).Copy wsNew.Rows(destRow)
            destRow = destRow + 1
        End If
    Next i
    Columns("C").ColumnWidth = 35 ' 列の幅の調節
    
End Sub

このコードを記入する場所なのですが、エクセルの【表示】→【マクロ】→【マクロの表示】の順で進んで。