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, 1Len(sTypeName) - 1)
End If

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


GetTypeName 
= InsertType(count, TypeName)

 
End Function
Function InsertType(count As Integer, stype() As StringAs 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 StringAs 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(
29), Cells(28 + curCount)).Merge
    
    InsertSubject 
= re
End Function

贴代码 的要换一下了,非常烂!!

原文地址:https://www.cnblogs.com/szyicol/p/1804618.html