閆冰洋　李維鳳

摘 要：本文利用Excel VBA技術(shù)設(shè)計(jì)門診藥房特殊藥品日發(fā)藥統(tǒng)計(jì)程序，對(duì)日發(fā)藥明細(xì)表數(shù)據(jù)按日進(jìn)行累加，得到每種藥品的日發(fā)藥明細(xì)數(shù)據(jù)，單次統(tǒng)計(jì)時(shí)間由原來(lái)的120 min以上降至2 min以內(nèi)，提高了門診藥房藥品統(tǒng)計(jì)效率。

關(guān)鍵詞：門診藥房;Excel VBA;藥品統(tǒng)計(jì)

中圖分類號(hào)：R197.324文獻(xiàn)標(biāo)識(shí)碼：A文章編號(hào)：1003-5168（2020）14-0021-03

The Statistical Program for Daily Delivery of Special Medicine in Outpatient Pharmacy Based On Excel VBA Technology

YAN Bingyang LI Weifeng

（School of Pharmacy， Medical College of Xi'an Jiaotong University，Xi'an Shaanxi 710061）

Abstract： This paper used Excel VBA technology to design a statistical program for daily delivery of special medicines in outpatient pharmacies， and accumulated daily delivery schedule data to obtain daily delivery breakdown data for each medicine. The single statistical time was reduced from more than 120 min to less than 2 min， which improved the efficiency of drug statistics in outpatient pharmacy.

Keywords： outpatient pharmacy;Excel VBA;drug statistics

隨著國(guó)家政策導(dǎo)向、藥學(xué)學(xué)科及技術(shù)的發(fā)展，藥學(xué)工作人員的工作重心逐步從發(fā)藥向提供合理的用藥藥學(xué)服務(wù)轉(zhuǎn)變，在這個(gè)過(guò)程中，越來(lái)越多的工作也會(huì)被賦予藥學(xué)工作人員，門診藥房藥師的工作也日漸繁重。隨著國(guó)家對(duì)藥品日常監(jiān)控的深入，門診藥房不僅要完成日常工作，還要每月配合相關(guān)部門完成特殊藥品的統(tǒng)計(jì)工作，如終止妊娠藥品、醫(yī)保指定藥品等的日發(fā)藥統(tǒng)計(jì)工作，而HIS系統(tǒng)由于引進(jìn)時(shí)間較長(zhǎng)不具備這項(xiàng)功能，每月的統(tǒng)計(jì)工作耗時(shí)耗力。VBA是一種宏語(yǔ)言，結(jié)合微軟辦公軟件很容易將日常工作流程轉(zhuǎn)換為VBA程序代碼，使藥學(xué)工作實(shí)現(xiàn)自動(dòng)化，如利用藥庫(kù)智能化辦公[1]、VBA編制中藥采購(gòu)軟件[2]、開發(fā)藥品配伍禁忌審查表[3]等。

本文將從門診藥房特殊藥品日發(fā)藥統(tǒng)計(jì)實(shí)際工作入手，分析目前工作的不足，利用Excel VBA語(yǔ)言設(shè)計(jì)特殊藥品日發(fā)藥統(tǒng)計(jì)程序，以提高特殊藥品日發(fā)藥統(tǒng)計(jì)效率。

1 資料與方法

1.1 特殊藥品日發(fā)藥統(tǒng)計(jì)程序的算法構(gòu)建

該程序的整體思路是：建立待統(tǒng)計(jì)特殊藥品清單，設(shè)計(jì)特殊藥品日發(fā)藥統(tǒng)計(jì)程序的算法，導(dǎo)入HIS系統(tǒng)導(dǎo)出的日發(fā)藥明細(xì)表，得到每種藥品的日發(fā)藥明細(xì)數(shù)據(jù)。

因庫(kù)存藥品存在同名稱、多規(guī)格、多廠家的情況，只檢索藥品名稱無(wú)法確定藥品的唯一性，故采用藥典編號(hào)確定藥品的唯一性。

1.1.1 日發(fā)藥明細(xì)表。選擇起始日期及終止日期，從醫(yī)院HIS系統(tǒng)查詢導(dǎo)出日發(fā)藥明細(xì)表，保存成“.xls”格式。導(dǎo)出的日發(fā)藥明細(xì)表格式如表1所示。

1.1.2 庫(kù)存盤點(diǎn)表排序與排版。為保證庫(kù)存盤點(diǎn)有序進(jìn)行，根據(jù)貨架位置進(jìn)行排序，并進(jìn)行排版。

1.2 特殊藥品日發(fā)藥統(tǒng)計(jì)程序設(shè)計(jì)

程序包括導(dǎo)入HIS系統(tǒng)導(dǎo)出的日發(fā)藥明細(xì)、統(tǒng)計(jì)指定藥品日發(fā)藥明細(xì)等過(guò)程。

從HIS系統(tǒng)中導(dǎo)出日發(fā)藥明細(xì)表，導(dǎo)入門診藥房特殊藥品日發(fā)藥統(tǒng)計(jì)程序，保存在數(shù)組arr_rfyyssj中，利用字典統(tǒng)計(jì)指定品種的藥品日發(fā)藥明細(xì)[4-5]，VBA代碼示例如下：

Sub 指定品種日發(fā)藥明細(xì) （）

Dim wb As Workbook

Dim sht_db As Worksheet

Dim sht1 As Worksheet

Dim sht_fymx As Worksheet

Dim i， k

Dim arr_rfyyssj， arr_yfy， arr_rq， arr_cxpz， arr_bt '日發(fā)藥原始數(shù)據(jù)，發(fā)藥數(shù)據(jù)，日期，查詢品種，標(biāo)題

Dim dict_ydbh As Object， dict_yfy As Object， dict_rq As Object ? '藥典編號(hào)單位，月發(fā)藥數(shù)量

Set dict_ydbh = CreateObject（"Scripting.Dictionary"）

Set dict_yfy = CreateObject（"Scripting.Dictionary"）

Set dict_rq = CreateObject（"Scripting.Dictionary"）

Set sht_db = ThisWorkbook.Worksheets（"datebase"）

Set sht1 = ThisWorkbook.Worksheets（"sheet1"）

Set sht_fymx = ThisWorkbook.Worksheets（"日發(fā)藥明細(xì)"）

Application.ScreenUpdating = False

Cells.Borders.LineStyle = xlNone

arr_cxpz = sht_fymx.[A1].Resize（[A1].End（xlDown）.Row， 26）

'清除歷史數(shù)據(jù)

[C3].Resize（UBound（arr_cxpz， 1）， 40） = ""

For i = 3 To UBound（arr_cxpz， 1）

dict_ydbh（arr_cxpz（i， 1）） = ""

Next i

Set wb = Workbooks.Open（sht_db.[Q7].Value）

arr_rfyyssj = wb.Worksheets（1）.Range（"B1"）.Resize（Cells（[A1].End（xlDown）.Row， 2）.End（xlUp）.Row， 26）

wb.Close

For i = 2 To UBound（arr_rfyyssj， 1）

If dict_ydbh.exists（arr_rfyyssj（i， 26）） Then

dict_rq（Format（arr_rfyyssj（i， 14）， "m/d"）） = arr_rfyyssj（i， 6） & "-" & arr_rfyyssj（i， 7） & "-" & arr_rfyyssj（i， 8）

dict_yfy（arr_rfyyssj（i， 26）） = arr_rfyyssj（i， 6） & "-" & arr_rfyyssj（i， 7） & "-" & arr_rfyyssj（i， 8）

dict_yfy（arr_rfyyssj（i， 26） & "/" & Format（arr_rfyyssj（i， 14）， "m/d"）） = dict_yfy（arr_rfyyssj（i， 26） & "/" & Format（arr_rfyyssj（i， 14）， "m/d"）） + arr_rfyyssj（i， 11）

End If

Next i

arr_yfy = Application.Transpose（dict_ydbh.keys）

arr_rq = Application.Transpose（dict_rq.keys）

ReDim Preserve arr_yfy（1 To dict_ydbh.Count， 1 To dict_rq.Count + 2）

For i = 1 To UBound（arr_yfy， 1）

arr_yfy（i， 2） = dict_yfy（arr_yfy（i， 1））

For k = 1 To dict_rq.Count

arr_yfy（i， 2 + k） = dict_yfy（arr_yfy（i， 1） & "/" & arr_rq（k， 1））

Next k

Next i

ReDim arr_bt（1 To 1， 1 To UBound（arr_rq， 1） + 2）

For i = 1 To UBound（arr_rq， 1）

arr_bt（1， i + 2） = arr_rq（i， 1）

Next i

arr_bt（1， 1） = "藥典編號(hào)"

arr_bt（1， 2） = "藥品信息"

sht_fymx.[A2].Resize（1， UBound（arr_bt， 2）） = arr_bt

sht_fymx.[A3].Resize（dict_ydbh.Count， dict_rq.Count + 2） = arr_yfy

'自動(dòng)居中，適合單元格調(diào)整字體

With [C2].Resize（UBound（arr_yfy， 1） + 1， UBound（arr_yfy， 2） - 2）

.HorizontalAlignment = xlCenter

.VerticalAlignment = xlCenter

.ShrinkToFit = True

End With

With [A2].Resize（UBound（arr_yfy， 1） + 1， 1）

.HorizontalAlignment = xlCenter

.VerticalAlignment = xlCenter

.ShrinkToFit = True

End With

'添加邊框線

With [A2].Resize（UBound（arr_yfy， 1） + 1， UBound（arr_yfy， 2））.Borders

.LineStyle = xlContinuous

.Weight = xlThin

End With

ActiveSheet.PageSetup.PrintTitleRows = "$1：$2"