作者：乔山办公网日期：
返回目录：excel表格制作
1、表1的D4单元格输入公式：
=IF(C4="",IF(B4="",A4,B4),C4)
复制并下拉，即可在D4开始得到连续的名称了zhidao
2、在表2的A4单元格版输入公式：
=OFFSET(Sheet1!$D$3,(ROW()-1)/3,0)
3、合并A4、A5、A6单元格，再在B4、B5、B6这3个单元格分别输入：
合计、国有、集体这3个词组
4、选择A3:B6单元格区域，整体复制并下拉3点倍数行，即可得到图2的效果权啦！
网上大把，不过就是利息高时间短。我已经进坑了，不要弄这些了
你将表中的“#DIV/0!"全部清掉，就可以了。
Public Shared Function ExportExceldr(ByVal Drv As DataTable, ByVal ECode As String) As Boolean
Dim BOO As Boolean = False '定义执行结果状态
If Drv Is Nothing OrElse Drv.Rows.Count = 0 Then '没有数据直接返回
Return BOO
End If
Dim SaveFileDialog1 As New SaveFileDialog '实例化文件保存提示框
SaveFileDialog1.Filter = "文件(*.xls)|*.xls" '设置保存文件类型
SaveFileDialog1.FileName = ECode '默认文件名
SaveFileDialog1.FilterIndex = 1 '默认筛选
SaveFileDialog1.InitialDirectory = Application.StartupPath '默认当前路径
If SaveFileDialog1.ShowDialog() = Windows.Forms.DialogResult.OK Then '用户点了确认
Try
Dim m_image As String = SaveFileDialog1.FileName '保存Excel路径和文件名称
Dim xlApp As Excel.Application = CreateObject("Excel.Application") '定义Excel对象
Dim xlBook As Excel.Workbook = xlApp.Workbooks.Add() '新增工作簿
Dim sheet As Excel.Worksheet = xlBook.Worksheets(1) '定义工作表
Dim col As Integer = 0 '定义列
Dim row As Integer = 0 '定义行
Dim satData(,) As Object = New Object(Drv.Rows.Count, col) {} '定义二维数组给工作表赋值
For Each dl As DataColumn In Drv.Columns '按列开始循环赋值
row = 0 '行每次从0开始
ReDim Preserve satData(Drv.Rows.Count, col) '重新定义数据
satData(row, col) = dl.ColumnName '赋值列标题
For Each dr As DataRow In Drv.Rows '按行循环
row += 1 '下一行
satData(row, col) = dr(dl.ColumnName) '赋值表内容
Next
col += 1 '下一列
Next
row += 1 '再增加一行，因为包含标题行
sheet.Range(sheet.Cells(1, 1), sheet.Cells(row, col)).Value2 = satData '数组赋值到工作表区域
sheet.Range(sheet.Cells(1, 1), sheet.Cells(1, col)).Font.Bold = True '标题行字体7a686964616fe59b9ee7ad94339加粗
With sheet.Range(sheet.Cells(1, 1), sheet.Cells(1, col))
.Interior.ColorIndex = 34 '标题行加颜色
.Borders.LineStyle = 1 '加边框
.HorizontalAlignment = 3 '水平居中
.Font.Size = 10 '字体大小
.EntireColumn.AutoFit() '自动调整列宽
End With
sheet.Cells(2, 2).Activate() '激活单元格
sheet.Cells(2, 2).Application.ActiveWindow.FreezePanes = True '固定窗口
If xlBook.Sheets.Count > 1 Then
For i = xlBook.Sheets.Count To 2 Step -1
xlApp.DisplayAlerts = False
CType(xlBook.Worksheets(i), Excel.Worksheet).Delete() '删除多余工作表
Next
End If
xlBook.SaveAs(Filename:=m_image) '保存工作簿
xlApp.Visible = True '可以显示出来了
xlBook = Nothing '释放xlBook
xlApp = Nothing '释放xlApp对象
GC.Collect() '垃圾回收
Catch ex As Exception
MessageBox.Show(ex.ToString)
BOO = True
End Try
GC.Collect()
End If
Return BOO
End Function