`
myangle89
  • 浏览: 96150 次
  • 性别: Icon_minigender_1
  • 来自: 上海
社区版块
存档分类
最新评论

excel报表开发点滴

阅读更多
这几天公司有个报表开发需求,UI要求也相当高,讨论决定使用excel模版来做报表需求。

报表开发主要使用宏,后端是JAVA调用POI进行隐藏sheet的数据填充,最后执行宏绘制报表。

宏如下:
Sub auto_Open()
    Sheets("i18n").Select
    v = Range("B2").Value
    If v = 0 Then
        TravellerReprot
        Sheets("i18n").Select
        Range("B2").Value = 1
        
        Sheets("Traveller Anlysis Report").Select
        ActiveWorkbook.Save
    End If
    Sheets("Traveller Anlysis Report").Select
End Sub

Rem 差旅人报表数据
Sub TravellerReprot()

    '------------------------常量定义------------------------
    '预留行数
    Const limitNum = 23
    
    '数据开始行数
    Const startNum = 7
    
    'en_US
    Const en_US_TitleMain = "Business Travel Account"
    
    Const en_US_TitleMain2 = "Traveler Analysis Report For 2012-01-01 To 2012-03-01"
    
    Const en_US_AccountName = "Account Name:"
    
    Const en_US_AccountNumber = "Account Number:"
    
    Const en_US_GenerationDate = "Generation Date:"
    
    Const en_US_Traveler = "Traveler"
    
    Const en_US_Class = "Class"
    
    Const en_US_Routing = "Routing"
    
    Const en_US_DeptDate = "Dept Date"
    
    Const en_US_TicketNumber = "Ticket Number"
    
    Const en_US_ValueRMB = "Value RMB"
    
    Const en_US_BottomName = "This is a management information report and is not to be used for accounting purposes"
    
    Const en_US_Page = "Page Number 1 Of 1"
    
    Const en_US_TotalReport = "Report Totals"
    
    'zh_CN
    Const zh_CN_TitleMain = "商务旅行账户"
    
    Const zh_CN_TitleMain2 = "员工差旅分析(2012-01-01 到 20120-03-01)"
    
    Const zh_CN_AccountName = "企业名称:"
    
    Const zh_CN_AccountNumber = "企业编号:"
    
    Const zh_CN_GenerationDate = "报表生成日期:"
    
    Const zh_CN_Traveler = "差旅人"
    
    Const zh_CN_Class = "舱位"
    
    Const zh_CN_Routing = "航程"
    
    Const zh_CN_DeptDate = "起飞/交易日期"
    
    Const zh_CN_TicketNumber = "票号"
    
    Const zh_CN_ValueRMB = "交易金额"
    
    Const zh_CN_BottomName = "这是一个管理信息报告且不被用于会计目的"
    
    Const zh_CN_Page = "第1页 共1页"
    
    Const zh_CN_TotalReport = "报表总计"
    
    '------------------------逻辑处理------------------------
    Application.ScreenUpdating = False
    
    '1.i18n初始化
    Sheets("i18n").Select
    lang = Range("B1").Value
    Debug.Print "语言选择为" & lang
    
    Debug.Print "初始化国际化信息"
    Sheets("Traveller Anlysis Report").Select
    
    If lang = "en_US" Then
        Range("C1").Value = en_US_TitleMain
        Range("B2").Value = en_US_TitleMain2
        Range("A4").Value = en_US_AccountName
        Range("C4").Value = en_US_AccountNumber
        Range("E4").Value = en_US_GenerationDate
        Range("A6").Value = en_US_Traveler
        Range("B6").Value = en_US_Class
        Range("C6").Value = en_US_Routing
        Range("D6").Value = en_US_DeptDate
        Range("E6").Value = en_US_TicketNumber
        Range("F6").Value = en_US_ValueRMB
        Range("B32").Value = en_US_BottomName
        Range("C33").Value = en_US_Page
    Else
        Range("C1").Value = zh_CN_TitleMain
        Range("B2").Value = zh_CN_TitleMain2
        Range("A4").Value = zh_CN_AccountName
        Range("C4").Value = zh_CN_AccountNumber
        Range("E4").Value = zh_CN_GenerationDate
        Range("A6").Value = zh_CN_Traveler
        Range("B6").Value = zh_CN_Class
        Range("C6").Value = zh_CN_Routing
        Range("D6").Value = zh_CN_DeptDate
        Range("E6").Value = zh_CN_TicketNumber
        Range("F6").Value = zh_CN_ValueRMB
        Range("B32").Value = zh_CN_BottomName
        Range("C33").Value = zh_CN_Page
    End If
    
    '2.是否增行判断:有效数据行数与预留行数对比
    Sheets("data").Select
    activeNum = Range("A65536").End(xlUp).Row
    Debug.Print "有效数据行数为" & activeNum
    
    totalTraveller = Range("A" & activeNum).Value
    Debug.Print "差旅人总数为" & totalTraveller
    
    If activeNum > limitNum Then
         Debug.Print "有效数据行数大于预留行数,进行增行操作"
        insertNum = activeNum - limitNum
        
        For num = 1 To insertNum Step 1
            Sheets("Traveller Anlysis Report").Select
            Rows("8:8").Select
            Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
        Next num
        
    End If
    
    '3.数据填充
    Debug.Print "增行判断完毕,进行数据填充"
    
    '当前正在执行的行数
    curNum = startNum
    
    '当前正在执行的差旅人
    Dim curTravelerID As Integer
    
    '标记需要数据条的单元格
    Dim needColor() As String
    Dim colorNum As Integer
    
    '循环填充
    curTravelerID = 1
    colorNum = 1
    ReDim needColor(colorNum To totalTraveller)
    For temp = 1 To activeNum Step 1
        Sheets("data").Select
        travelerID = Range("A" & temp).Value
        
        '3.1差旅人是否和上一次的为同一差旅人
        If curTravelerID = travelerID Then
            isSameTraveler = True
        Else
            isSameTraveler = False
        End If
        curTravelerID = travelerID
        
    
        '3.2判断是否需要添加数据条标记
        If isSameTraveler = False Then
            needColor(colorNum) = "F" & (curNum - 1)
            colorNum = colorNum + 1
        End If
        
        '3.3复制差旅人数据
        Sheets("Traveller Anlysis Report").Select
        
        Range("A" & curNum).FormulaR1C1 = "=data!R[-6]C[1]"
        If Range("A" & curNum) = 0 Then
            Range("A" & curNum).Value = ""
        End If
        
        Range("B" & curNum).FormulaR1C1 = "=data!R[-6]C[1]"
        If Range("B" & curNum) = 0 Then
            Range("B" & curNum).Value = ""
        End If
        
        Range("C" & curNum).FormulaR1C1 = "=data!R[-6]C[1]"
        If Range("C" & curNum) = 0 Then
            Range("C" & curNum).Value = ""
        End If
        
        Range("D" & curNum).FormulaR1C1 = "=data!R[-6]C[1]"
        If Range("D" & curNum) = 0 Then
            Range("D" & curNum).Value = ""
        End If
        
        Range("E" & curNum).FormulaR1C1 = "=data!R[-6]C[1]"
        If Range("E" & curNum) = 0 Then
            Range("E" & curNum).Value = ""
        End If
        
        Range("F" & curNum).FormulaR1C1 = "=data!R[-6]C[1]"
        
        '3.4当前行+1,进入下次循环
        curNum = curNum + 1
    Next temp
    
    '3.5有效数据行的最后一行的最后一列加入needColor
    needColor(colorNum) = "F" & (curNum - 1)
    
    '4.设置样式表
    '需要设置的单元格
    Dim colorBarCells As String
    '单元格的总和
    Dim colorBarCellsSum As Long
    For i = 1 To UBound(needColor)
        colorBarCells = colorBarCells + needColor(i) + ","
        colorBarCellsSum = colorBarCellsSum + Range(needColor(i)).Value
    Next i
    
    colorBarCells = Mid(colorBarCells, 1, Len(colorBarCells) - 1)
    Debug.Print "待添加渐变单元格:" & colorBarCells
    Debug.Print "待添加渐变单元格的总和:" & colorBarCellsSum
    
    Sheets("Traveller Anlysis Report").Select
    Range(colorBarCells).Select
    Selection.FormatConditions.AddDatabar
    Selection.FormatConditions(Selection.FormatConditions.Count).ShowValue = True
    Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
    'With Selection.FormatConditions(1)
    '    .MinPoint.Modify newtype:=xlConditionValueLowestValue
   '     .MaxPoint.Modify newtype:=xlConditionValueHighestValue
   ' End With
    With Selection.FormatConditions(1).BarColor
        .Color = 8700771
        .TintAndShade = 0
    End With
    
    '5.设置统计栏
    Sheets("Traveller Anlysis Report").Select
    
    Range("A" & curNum).Select
    If lang = "en_US" Then
        Range("A" & curNum) = en_US_TotalReport
    Else
        Range("A" & curNum) = zh_CN_TotalReport
    End If
    Selection.Font.Bold = True
    
    Range("F" & curNum).Select
    Range("F" & curNum) = colorBarCellsSum
    Selection.Font.Bold = True
    
    Range("A" & curNum & ":" & "F" & curNum).Select
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    Selection.Borders(xlEdgeLeft).LineStyle = xlNone
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    Selection.Borders(xlEdgeBottom).LineStyle = xlNone
    Selection.Borders(xlEdgeRight).LineStyle = xlNone
    Selection.Borders(xlInsideVertical).LineStyle = xlNone
    Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
    
    Range("A65000").Select
    Application.ScreenUpdating = True
     
End Sub


特别注意的是注释那段,当关闭excel后会报告excel格式错误问题,但手动操作的没问题,非常怪异,特此标记一下。

VBA代码可以进一步进行优化,不过在那里面写真的是没eclipse方便...
另外经常写到循环或者判断的时候,打进去的代码居然是JAVA代码,悲催啊...
丫的,突然想起来这货不是JAVA啊~~~
  • 大小: 182.1 KB
分享到:
评论

相关推荐

Global site tag (gtag.js) - Google Analytics