VBA 在醫院統計領域的應用探討

李昕昊 周火明 賴伏虎 徐 俊 鄧娟娟 羅 燕

1 香港大學深圳醫院，518000 廣東 深圳； 2 深圳市寶安純中醫治療醫院，518101 廣東 深圳

visual basic for applications(簡稱VBA)是新一代標準宏語言，是基于visual basic for Windows 發展而來的。它與傳統的宏語言不同，傳統的宏語言不具有高級語言的特征，沒有面向對象的程序設計概念和方法；而VBA 提供了面向對象的程序設計方法，提供了相當完整的程序設計語言[1]。

VBA沒有自己獨立的工作環境，須依附于某一個主應用程序。VBA專門用于Office的各應用程序中，如Word、 Excel、 Access等。它的編寫是以子過程和函數為單位，在 Access中以模塊形式出現。隨著微軟辦公軟件的普遍化，靈活掌握VBA語言的使用，可以讓復雜的工作簡易化，減少不必要的重復性工作，提高工作效率[2-3]。

本文將從醫院日報制作、每月醫療質量公示數據自動生成拆分、臨床科室多維度多指標數據查詢3個項目闡述VBA在醫院統計中的應用。

1 醫院日報制作項目

1.1 制作流程

1)首先把門診報表、病房報表從BI決策支持系統導出。

2)點擊匯總模板中運行按鈕，程序自動把門診報表、病房報表中對應病區和科室的入院、出院、轉科等數據依次進行填充。

3)因存在患者出院召回、護士忘記預約登記出院等原因，造成BI決策支持系統中數據與HIS系統的數據不一致，所以需進行校核。先導出HIS系統中入院、出院、轉科的數據，再點擊核查模板中運行按鈕 ，程序自動將匯總模板的數據與從HIS系統導出的數據進行核對。

4)校核無誤后，點擊日報模板中運行按鈕，日報模板自動從匯總模板中讀取相關數據進行填充，日報模板數據填充完成，程序結束。見圖1。

圖1 醫院日報制作流程圖

1.2 部分VBA代碼

1.2.1 填充門診工作量代碼

Sub huizong_deal()

Application.ScreenUpdating = False ""關閉屏幕刷新

Application.Calculation = xlCalculationManual ""關閉自動計算，加快運行速度

On Error Resume Next

Dim FilesToOpen, FilesToOpen2, FilesToOpen3, arr1, brr1, arr2, brr2

Dim wb1_name As String, wb2_name As String, wb3_name As String, wb_name As String

Dim wb1 As Workbook, wb2 As Workbook, wb3 As Workbook

Dim i As Integer, j As Integer, i2 As Integer

Dim IRang As Range, IRang2 As Range, IRang3 As Range

ActiveSheet.Select

wb_name = ActiveWorkbook.Name

""填充門診工作量數據

FilesToOpen2 = Application.GetOpenFilename("Excel,*.xls;*.xlsx;*.xlsm", , "選擇【門診工作量報表(專科)】", , False)

If FilesToOpen2 = False Then

Exit Sub

Else

Set wb2 = Workbooks.Open(FilesToOpen2, 0)

End If

Workbooks(wb_name).Activate

For Each IRang2 In Workbooks(wb_name).ActiveSheet.Range("Q2:Q32")

For Each IRang3 In wb2.Sheets(1).Range("A5:A35")

If IRang2.Value = IRang3.Value Then

Workbooks(wb_name).ActiveSheet.Range("C" & IRang2.Row & ":" & "P" & IRang2.Row).Value = _

wb2.Sheets(1).Range("B" & IRang3.Row & ":" & "O" & IRang3.Row).Value

End If

Next

Next

Workbooks(wb_name).ActiveSheet.Range("Q2:Q32").ClearContents

""關閉專科表，不保存

wb2_name = wb2.Name

Workbooks(wb2_name).Close False

1.2.2 填充住院工作量代碼

""打開病房日記表,如果不選擇表，則退出

FilesToOpen = Application.GetOpenFilename("Excel,*.xls;*.xlsx;*.xlsm", , "選擇【病房日記表】", , False)

If FilesToOpen = False Then

Exit Sub

Else

Set wb1 = Workbooks.Open(FilesToOpen, 0)

End If

wb1_name = wb1.Name

j = ActiveSheet.Range("A6666").End(xlUp).Row

ActiveSheet.Columns("D:F").Hidden = True′隱藏D:F列

ReDim arr2(1 To j - 1, 1 To 1)

ReDim brr2(1 To j - 1, 1 To 1)

For i2 = 1 To j - 1

If Cells(i2 + 1, 1).Value <> "" Then

arr2(i2, 1) = Cells(i2 + 1, 1)

brr2(i2, 1) = arr2(i2, 1) & Cells(i2 + 1, 3)

Else

arr2(i2, 1) = arr2(i2 - 1, 1)

brr2(i2, 1) = arr2(i2 - 1, 1) & Cells(i2 + 1, 3)

End If

Next

Range("P2:P" & j) = brr2

For i = 1 To j - 1

Windows(wb1_name).Activate

If VBA.IsError(Application.VLookup(Range("P" & i + 1), IRang, 1, 0)) Then

If Range("C" & i + 1).Value <> "" Then

Range("G" & i + 1 & ":L" & i + 1).Interior.ColorIndex = 44

Range("N" & i + 1).Interior.ColorIndex = 44

Else

End If

Else

a = Application.Match(Range("P" & i + 1), IRang, 0)

Workbooks(wb_name).Activate

ActiveSheet.Range("F"&71+a-1&":K"&71+a-1).Value= Workbooks(wb1_name).Sheets(1).Range("G" & i + 1 & ":L" & i + 1).Value

ActiveSheet.Range("M"&71+a-1).Value= Workbooks(wb1_name).Sheets(1).Range("N" & i + 1).Value

End If

Next

Workbooks(wb_name).Activate

ActiveSheet.Range("P71:P888").ClearContents′清除輔助列的數據

Application.Calculation = xlCalculationAutomatic

Application.ScreenUpdating = True

End Sub

1.3 程序運行部分截圖

程序運行部分截圖見圖2、圖3。

圖2 匯總模板填充門診工作量數據

圖3 數據自動導入日報模板

1.4 效果比較

某編制2 000張病床38個住院臨床科室的三甲醫院，在未使用此程序前，統計員每天需要花費4 h完成醫療運營日報數據的人工填充，校核以及生成，且時常出現復制粘貼錯誤、數據錯行等問題。但自從使用VBA編碼程序后，統計員只需要每天點擊3個按鈕，依次選擇對應的Excel表格即可快速生成每天醫療運營日報。此過程花費不到10 min，不但提高了統計員的工作效率，而且數據質量也得到了很好的保障。

2 醫療質量公示數據項目

2.1 制作流程

1)首先收集12個職能部門關于臨床科室共90個醫療質量指標和重點手術、重點病種數據；

2)對收集的Excel表格檢查數據是否缺漏；

3)核查無誤后，點擊運行程序，輸入即將生成醫療質量公示數據的年月份，點擊確認，等待程序運行結束，共生成38個臨床科室醫療質量公示數據表。

2.2 部分VBA程序代碼

2.2.1 讀取重點疾病和手術的路徑、輸入年月份的代碼

Sub 醫療公示數據()

Application.ScreenUpdating = False′關閉屏幕更新

Application.DisplayAlerts = False′關閉警告開關

Dim FilesToOpen1, FilesToOpen2

Dim n As Byte, i As Byte, j As Byte, m As Byte, s As Byte

Dim wb1 As Workbook, wb2 As Workbook, wb1_again As Workbook

Dim ws1 As Worksheet, ws2 As Worksheet, ws3 As Worksheet

Dim wb1_name As String, wb2_name As String, New_wb1_name As String, FilesAllname As String, NameLineName As String

Dim x1 As Integer, y1 As Long

Dim New_name, New_Path′定義新名稱，新路徑

Dim wb3 As Workbook, k As Byte, w As Byte, g As Byte

Dim yuefen As String′定義月份的文字

""需要確認是否修改了讀取重點疾病和手術的路徑，避免讀取其他月份的數據

TS = MsgBox("是否已經更新重點疾病和手術手術的當月路徑？", vbYesNo)

If TS <> vbYes Then

Exit Sub

Else

End If

""主動輸入月份，避免忘記修改月份

yuefen = InputBox("請輸入年月份", "hello", , 2500, 3500)

""專科重點疾病數據處理部分

Set wb1 = ActiveWorkbook

wb1_name = ActiveWorkbook.Name

FilesAllname = ActiveWorkbook.Path & "”& wb1_name '獲取路徑和名稱，方便最后重新打開

New_Path = wb1.Sheets("指標數據抽取").Range("B6").Value ′最終導出文件的路徑

""New_name = wb1.Sheets("指標數據抽取").Range("B3").Value

FilesToOpen1 = wb1.Sheets("指標數據抽取").Range("B1").Value′讀取重點疾病數據路徑

FilesToOpen2 = wb1.Sheets("指標數據抽取").Range("B2").Value′讀取重點手術數據路徑

2.2.2 遍歷文件夾讀取即將生成的科室名稱

""通過讀取文件夾的方式復制每個工作簿的那一行科室名稱

f_name = Dir(wb1.Path & "〔.xlsx") ′搜索當前文件夾

Do While f_name <> ""

wb1_name = ActiveWorkbook.Name

Set wb1 = ActiveWorkbook

If f_name <> wb1_name Then

Set wb3 = Workbooks.Open(wb1.Path & "、" & f_name)

For w = 1 To wb3.Sheets.Count

For g = 1 To wb1.Sheets.Count

If wb3.Sheets(w).Name = wb1.Sheets(g).Name Then

If wb3.Sheets(w).Name = "基本質控指標" Or wb3.Sheets(w).Name = "基本質控指標 --IMC" Then

k = wb3.Sheets(w).UsedRange.Columns.Count

wb3.Sheets(w).Activate

wb3.Sheets(w).Range(Cells(2, 5), Cells(2, k)).Copy

wb1.Sheets(g).Activate

wb1.Sheets(g).Cells(2, 5).PasteSpecial Paste:=xlPasteValues

wb1.Sheets(g).Range(Cells(1, 1), Cells(1, k)).Merge ""合并標題單元格

wb1.Sheets(g).Range(Cells(2, 5), Cells(2, k)).Columns.AutoFit ""自動調節列寬

wb1.Sheets(g).Columns(k + 1).Resize(, 20 - k).Delete

End If

End If

Next

Next

On Error Resume Next

Dim arr1, d As Object ""字典，刪除多余的表

Set d = CreateObject("scripting.dictionary")

ReDim arr1(1, 1 To wb3.Sheets.Count)

For w = 1 To wb3.Sheets.Count

arr1(1, w) = wb3.Sheets(w).Name

d(arr1(1, w)) = ""

Next

For g = 1 To wb1.Sheets.Count

If d.exists(wb1.Sheets(g).Name) Then

Else

wb1.Sheets(g).Delete

g = g - 1

End If

Next

Set d = Nothing

Set arr1 = Nothing

End If

wb3.Close False

f_name = Dir′找尋下一個excel文件，否則無限循環

2.2.3 讀取各科室重點疾病數據代碼

""專科重點疾病數據處理部分

Sub Savetime(ws1 As Worksheet, ws2 As Worksheet)

On Error Resume Next "如果后面的程序出現"運行時錯誤"時，會繼續運行，不中斷

Application.ScreenUpdating = False′關閉屏幕更新

Application.DisplayAlerts = False′關閉警告開關

Dim IRange As Range

Set IRange = ws2.Range("F:F")

ws1.Activate

x1 = ws1.UsedRange.Columns.Count′讀取第二行的列數，方便統計有幾個科室

ws1.Rows(2).Insert

For n = 4 To x1

ActiveSheet.Cells(2, n) = Application.WorksheetFunction.CountIf(IRange, Cells(3, n))

Next

y1 = Application.WorksheetFunction.Max(Range(Cells(2, 4), Cells(2, x1)))

Set ws1 = ActiveSheet

ActiveSheet.Range(Cells(4, 1), Cells(4 + (y1 - 1) * 9, 1)).Merge

For j = 4 To x1

m = 0

For i = 3 To ws2.Range("F6666").End(xlUp).Row

If ws1.Cells(3, j) = ws2.Cells(i, 6) Then

m = m + 1

If m = 1 Then

ws2.Activate

ws2.Range(Cells(i, 7), Cells(i, 15)).Copy

ws1.Activate

ws1.Cells(4, j).PasteSpecial Paste:=xlPasteValues, Transpose:=True

Else

ws2.Activate

ws2.Range(Cells(i, 7), Cells(i, 15)).Copy

ws1.Activate

ws1.Cells(4 + 9 * (m - 1), j).PasteSpecial Paste:=xlPasteValues, Transpose:=True

End If

End If

Next

Next

wb1.Activate

ws1.Rows(2).Delete′刪除輔助行

ws1.Range("B3").Select′凍結窗體

ActiveWindow.FreezePanes = True

ws1.Rows("3:" & ws1.Range("B6666").End(xlUp).Row).AutoFit""自動調節行距

End Sub

2.3 程序運行部分截圖

程序運行部分截圖見圖4。

圖4 生成38個科室醫療質量公示數據Excel文件

2.4 效果比較

每月共38個臨床科室，每個科室90個醫療質控指標和重點病種、重點手術明細數據，如果人工處理，統計員需要花費1 周的時間才能整理完成，并且數據經常出現錯漏的情況，數據質量得不到保障。自從統計員使用此VBA程序后，效率快速提高，每月花費時

間不超過1 h就能完成，不再出現復制粘貼有誤、錯行等原因導致數據出錯的現象。

3 Access多指標數據查詢項目

3.1 項目背景

醫院門診、住院基本醫療數據查詢需求量大，且時常要求統計員短時間內統計出結果，需求涉及三級公立醫院績效考核數據、住院醫師培訓基地督導、重點專科申報、科室診療質量基線調研、“3名工程”等。如果統計員使用廣東省病案統計管理系統軟件查詢數據，不僅費時費力，而且存在軟件運行效率低，操作不便等問題。所以運用VBA語言和數據庫的原理研發Access多指標數據查詢數據庫，讓數據查詢速度更快，操作更加靈活便捷[4]。

3.2 部分VBA程序代碼

3.2.1 更新基礎數據中住院架構代碼

Sub GX更新住院架構_Click()

DoCmd.Close acTable, "A新住院架構" '先關閉，否則會引起錯誤值

Call AddFile

If Len(AddFileName) = 0 Then

MsgBox "未選取工作簿，退出導入！", vbInformation + vbOKOnly, "信息提示"

Exit Sub

End If

ACName = CurrentProject.Name

' On Error GoTo End_Sub

Err.Clear′清除錯誤值

DoCmd.SetWarnings False′忽略警示

DoCmd.RunSQL "delete * From A新住院架構"

DoCmd.RunSQL "insert into A新住院架構(序號,大專科管理科室,專科管理科室,亞專科,績效單元,直報分科單元,住院類型,科室名稱,HIS科號,統一科號病案,維護科號病案)"&

_ "select 序號,大專科管理科室,專科管理科室,亞專科,績效單元,直報分科單元,住院類型,科室名稱,HIS科號,統一科號病案,維護科號病案"& _

DoCmd.SetWarnings True′恢復警示

MsgBox "住院架構更新導入成功！", vbInformation + vbOKOnly, "信息提示"

Exit Sub

End_Sub:

DoCmd.SetWarnings True′恢復警示

Msg = "錯誤編號 #"& Str(Err.Number) & "出錯原因" _

& Err.Source & Chr(13) & Err.Description

MsgBox Msg, , "Error", Err.HelpFile, Err.HelpContext

End Sub

Function AddFile()

Dim FD As FileDialog

Set FD = Application.FileDialog(msoFileDialogOpen)

With FD

.FilterIndex = 15

.InitialFileName = ""

If .Show = -1 Then

AddFileName = .SelectedItems(1)

Else

AddFileName = ""

Exit Function

End If

End With

End Function

3.2.2 住院工作量多指標數據查詢代碼

""住院工作量

strsql = "SELECT A新住院架構.序號, A新住院架構.大專科管理科室, A新住院架構.專科管理科室, A新住院架構.亞專科, A新住院架構.績效單元, " _

& "A新住院架構.直報分科單元, A新住院架構.住院類型,A新住院架構.HIS科號, 多指標源數據表.年月, " _

& zyzblx2 _

& " FROM A新住院架構 INNER JOIN 多指標源數據表 ON A新住院架構.HIS科號 = 多指標源數據表.HIS科號"

Set zysql = CurrentDb.CreateQueryDef("過程表", strsql)

strsql2 = "PARAMETERS [Forms]![多指標數據查詢]![dzb_start時間] Text ( 255 ), [Forms]![多指標數據查詢]![dzb_finish時間] Text ( 255 ), " _

& "[Forms]![多指標數據查詢]![dzb_架構類型] Short;" _

& " SELECT 過程表.大專科管理科室," & Forms!多指標數據查詢!dzb_架構類型 & "," & zyzblx _

& " FROM 過程表 " _

& "WHERE 過程表.住院類型 In (" & qylx & ")" _

& "And (int(過程表.年月) " _

& "Between Forms!多指標數據查詢!dzb_start時間 And Forms!多指標數據查詢!dzb_finish時間)" _

& " GROUP BY 過程表.序號,過程表.大專科管理科室," & Forms!多指標數據查詢!dzb_架構類型 & " ORDER BY 過程表.序號"

Set zysql2 = CurrentDb.CreateQueryDef("多指標數據查詢住院-" & qylxmc, strsql2) ""

DoCmd.OpenQuery zysql2.Name

Application.Echo True ""啟用刷寫屏幕

3.3 程序運行部分截圖

程序運行部分截圖見圖5、圖6。

圖5 Access多指標數據查詢主界面

圖6 Access多指標數據查詢結果(模擬數據)

3.4 效果比較

通過Access數據庫的研發，醫院統計員每次只需要選擇符合的統計范圍和指標類型，選擇展現的架構類型，單擊查詢按鈕運行程序，數據便會快速呈現，而不再使用廣東省病案統計管理系統或撰寫SQL腳本在SQL server數據庫客戶端進行查詢，效率得到很大的提升。前期通過對Access數據庫研發，可以根據自己的需求進行靈活設計，統計員平時只需維護基礎表即可。Access數據庫的使用保障了數據的穩定性，不會隨著業務數據的變動或人為誤操作而造成不同時間查詢的指標數據不一致的現象，并且使用界面簡潔，非專業編程人員也能熟悉使用。

4 小結

本文通過3個項目實例，介紹了VBA在醫院統計領域的應用。VBA不僅能幫助醫院統計員從日常重復枯燥的工作中擺脫出來，提高工作效率，從而專注于更高質量的腦力勞動，而且能保證數據質量。在醫院信息化建設程度不高且沒有更好的BI決策系統或RPA機器人等輔助工具的情況下[5]，采用VBA編程是一個不錯的選擇。VBA 易于學習掌握，醫院統計員在日常工作中也可以使用宏記錄器記錄用戶的各種操作并將其轉換為VBA代碼[6]，快速將日常工作轉換為VBA 程序代碼，使工作自動化。如遇到更復雜的需求，則需要了解VBA編程的編寫邏輯，或者RPA機器人平臺的“錄像(record)”/“編輯(edit)”功能。總之，VBA是適用于醫院統計應用場景的一種較好的工具，醫院統計人員可在實際工作中掌握使用。