医保大病支付统计

djk1020

这是给一个在保险公司上班的亲戚编写的，现分享给有需要的人：

根据上表数据统计出下表数据（搞不懂为何医院所用软件导出的表要用那么多个单元格合并来表示一个数据，难道是给统计设置障碍？！）

1. Sub DBZF()
   
2.     '大病支付及补偿统计
   
3.     Dim Bk As Workbook
   
4.     Set Bk = ActiveWorkbook
   
5.     If InStr(Bk.Name, "医保住院明细") > 0 Then
   
6.         Application.ScreenUpdating = False
   
7.         Dim Sht As Worksheet
   
8.         Set Sht = Bk.Worksheets(2)
   
9.         With Sht
   
10.             .Cells.Clear
    
11.             .Rows.RowHeight = 30
    
12.             .Columns.ColumnWidth = 17
    
13.             With .Range("A1:D5")
    
14.                 .Borders(xlEdgeLeft).LineStyle = xlContinuous
    
15.                 .Borders(xlEdgeRight).LineStyle = xlContinuous
    
16.                 .Borders(xlEdgeTop).LineStyle = xlContinuous
    
17.                 .Borders(xlEdgeBottom).LineStyle = xlContinuous
    
18.                 .Borders(xlInsideVertical).LineStyle = xlContinuous
    
19.                 .Borders(xlInsideHorizontal).LineStyle = xlContinuous
    
20.                 .HorizontalAlignment = xlRight
    
21.             End With
    
22.             .Cells(2, 1).Value = "大病支付(400元)"
    
23.             .Cells(3, 1).Value = "大病支付(其 它)"
    
24.             .Cells(4, 1).Value = "大病二次补偿"
    
25.             .Cells(5, 1).Value = "合计"
    
26.             .Cells(1, 2).Value = "人数"
    
27.             .Cells(1, 3).Value = "总金额"
    
28.             .Cells(1, 4).Value = "大病支付合计"
    
29.             .Range("C2:D5").NumberFormatLocal = "￥#,##0.00;￥-#,##0.00"
    
30.             .Cells(2, 2).Value = "=countif(sheet1!au:av,""400"")"
    
31.             .Cells(3, 2).Value = "=countif(sheet1!au:av,"">0"")-b2"
    
32.             .Cells(4, 2).FormulaArray = "=SUM(IF(ISNUMBER(Sheet1!AZ1:BH4096+0),IF(Sheet1!AZ1:BH4096+0>0,1,0),0))"
    
33.             .Cells(2, 3).Value = "=b2*400"
    
34.             .Cells(3, 3).Value = "=sum(sheet1!au:av)-c2"
    
35.             .Cells(4, 3).FormulaArray = "=SUM(IF(ISNUMBER(Sheet1!AZ1:BH4096+0),Sheet1!AZ1:BH4096+0,0))"
    
36.             .Cells(5, 3).Value = "=sum(c2:c4)"
    
37.             .Cells(2, 4).Value = "=sum(c2:c3)"
    
38.             .Select
    
39.         End With
    
40.         Application.ScreenUpdating = True
    
41.     End If
    
42. End Sub
    

复制代码