asp.net生成excel高级报表
时间：2010-08-20 来源：szyicol
根据该博文 ：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
贴代码 的要换一下了，非常烂！！
相关阅读 更多 +
