asp.net生成excel高级报表

根据该博文 ：http://www.cnblogs.com/xiaobier/archive/2008/10/13/1310399.html

自己做了一个excel账单

跟他不同的是，我的数据是行和列都是动态，而不是简单的行动态!

格式原图:

 

 生成的结果

 

 个人觉得用这种方式是非常的方便，asp.net只需要获取数据填写到excel中，其它事情由宏来处理，也就是说，今天客户要这个格式，明天要那个格式，只需要调整一下模板中的宏就好了，其它就不动了！

贴点代码给自己存档

Function FillData() As String
Dim a As String
On Error GoTo err
Dim re As Integer
'首先要确认有多少类别
re = GetTypeName

'插入数据
InsertData re

Sheet1.Select
Sheet1.Range("A1").Select
FillData = ""
Exit Function
err:
FillData = err.Description
End Function


Sub InsertData(cols As Integer)
Dim i As Integer
Dim j As Integer
Dim k As Integer
Dim x As Integer

Dim count1 As Integer
Dim count2 As Integer
Dim t1 As String
Dim t2 As String
Dim b As Boolean


Sheet1.Select

Sheet1.Range("B1").FormulaR1C1 = Sheet2.Range("C2").FormulaR1C1

count1 = Sheet2.UsedRange.Rows.count
For j = 2 To count1
    '先插入一行，将主数据填入
    Sheet1.Rows("5:5").Select
    Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
    Sheet1.Range("A5").Select
    Selection.NumberFormatLocal = "@"
    Sheet1.Range("A5").FormulaR1C1 = Sheet2.Range("E" & j).FormulaR1C1
    Sheet1.Range("B5").FormulaR1C1 = Sheet2.Range("B" & j).FormulaR1C1
    Sheet1.Range("C5").FormulaR1C1 = Sheet2.Range("D" & j).FormulaR1C1
    Sheet1.Range("D5").FormulaR1C1 = Sheet2.Range("I" & j).FormulaR1C1
    Sheet1.Range("E5").FormulaR1C1 = Sheet2.Range("H" & j).FormulaR1C1
    Sheet1.Range("F5").FormulaR1C1 = Sheet2.Range("F" & j).FormulaR1C1
    Sheet1.Range("G5").FormulaR1C1 = Sheet2.Range("G" & j).FormulaR1C1
    '这是主信息的keyid
    t1 = Sheet2.Range("A" & j).FormulaR1C1
    '开始插入明细
    count2 = Sheet3.UsedRange.Rows.count
    For i = 2 To count2
        b = False

        '如果订单ID相同
        If t1 = Sheet3.Range("A" & i).FormulaR1C1 Then
            '这是科目和币别
            t2 = Sheet3.Range("B" & i).FormulaR1C1 & "(" & Sheet3.Range("C" & i).FormulaR1C1 & ")"
            For k = 8 To 7 + cols
                '如果是科目相同
                If t2 = Sheet1.Range(Cells(3, k), Cells(3, k)).FormulaR1C1 Then
                    x = k
                    Do While x > 0
                        '分类也相同
                        If Sheet1.Range(Cells(2, x), Cells(2, x)).FormulaR1C1 = Sheet3.Range("E" & i).FormulaR1C1 Then
                        
                            Sheet1.Range(Cells(5, k), Cells(5, k)).FormulaR1C1 = Sheet3.Range("D" & i).FormulaR1C1
                            Sheet1.Range(Cells(5, k), Cells(5, k)).Select
                                Selection.NumberFormatLocal = "0.00_ "
                                With Selection
                                    .HorizontalAlignment = xlRight
                                    .VerticalAlignment = xlCenter
                                    .WrapText = False
                                    .Orientation = 0
                                    .AddIndent = False
                                    .IndentLevel = 0
                                    .ShrinkToFit = False
                                    .ReadingOrder = xlContext
                                    .MergeCells = False
                                End With
    
                            b = True
                            Exit Do
                        End If
                        x = x - 1
                    Loop
                End If
                If b = True Then Exit For
            Next k
        End If

    Next i
Next j

Sheet1.Rows(4).Select
Selection.Delete Shift:=xlUp
Sheet1.Rows(3 + count1).Select
Selection.Delete Shift:=xlUp


Dim y As Integer
For y = 1 To 7
    Sheet1.Columns(y).Select
    Selection.EntireColumn.AutoFit
Next y


'计算不同币别的总计
Sheet3.Select
Dim ic As Integer
ic = 1
t1 = ""
t2 = ""
For i = 2 To count2
    t1 = Sheet3.Range("C" & i).FormulaR1C1
    
    If InStr(1, t2, t1) = 0 Then
        Sheet3.Range("A" & (count2 + ic)).FormulaR1C1 = "=SUMIF(C[2] ,""" & t1 & """,C[3])"
        Sheet1.Range("B" & Sheet1.UsedRange.Rows.count).FormulaR1C1 = Sheet1.Range("B" & Sheet1.UsedRange.Rows.count).FormulaR1C1 & "    " & t1 & ":" & Sheet3.Range("A" & (count2 + ic)).Value
        t2 = t2 & t1 & ","
        ic = ic + 1
    End If
Next i


End Sub

Function GetTypeName() As Integer
'取得有多少大类
Dim re As Integer
Dim i As Integer
Dim count As Integer

Dim TypeName() As String

Dim sTypeName As String
Dim t1 As String
count = Sheet3.UsedRange.Rows.count
For i = 2 To count
    t1 = Sheet3.Range("E" & i).FormulaR1C1
    If InStr(1, sTypeName, t1) = 0 Then
        sTypeName = sTypeName & t1 & ","
    End If
Next i
If Len(sTypeName) > 0 Then
    sTypeName = Mid(sTypeName, 1, Len(sTypeName) - 1)
End If

TypeName = Split(sTypeName, ",")
count = UBound(TypeName) + 1


GetTypeName = InsertType(count, TypeName)

 
End Function
Function InsertType(count As Integer, stype() As String) As Integer
    '循环类别列
    Dim re As Integer
    
    Dim i As Integer
    If count = 0 Then
        Exit Function
    End If
    Sheet1.Select
    For i = 1 To count
        Sheet1.Range("H2").FormulaR1C1 = stype(i - 1)
        re = re + InsertSubject(stype(i - 1))
    Next i
    Sheet1.Columns("H:H").Select
    Selection.Delete Shift:=xlToLeft
    InsertType = re
End Function
Function InsertSubject(s As String) As Integer
    
    '插入科目
    Dim re As Integer
    Dim i As Integer
    Dim curCount As Integer
    Dim t1 As String
    Sheet1.Select
    
    count = Sheet3.UsedRange.Rows.count
For i = 2 To count
    If Sheet3.Range("E" & i).FormulaR1C1 = s Then
        t1 = Sheet3.Range("B" & i).FormulaR1C1 & "(" & Sheet3.Range("C" & i).FormulaR1C1 & ")"
        Sheet1.Range("H3").FormulaR1C1 = t1
        '设置公式
        Sheet1.Range("H6").Select
        Sheet1.Range("H6").FormulaR1C1 = "=SUM(R[-2]C:R[-1]C)"
        Selection.NumberFormatLocal = "0.00_ "
        With Selection
            .HorizontalAlignment = xlRight
            .VerticalAlignment = xlCenter
            .WrapText = False
            .Orientation = 0
            .AddIndent = False
            .IndentLevel = 0
            .ShrinkToFit = False
            .ReadingOrder = xlContext
            .MergeCells = False
        End With
        
        Sheet1.Columns("H:H").Select
        
        '自动列宽
        Selection.EntireColumn.AutoFit
        re = re + 1
        Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
        curCount = curCount + 1
    End If
Next i
    

    Sheet1.Range(Cells(2, 9), Cells(2, 8 + curCount)).Merge
    
    InsertSubject = re
End Function

贴代码 的要换一下了，非常烂！！