专家坐堂-导出EXCEL行合并问题Foxtable(狐表) - 新一代数据库软件，完美融合Access、Foxpro、Excel、vb.net之优势，人人都能掌握的快速软件开发工具!

以文本方式查看主题

-  Foxtable(狐表)  (http://foxtable.com/bbs/index.asp)
--  专家坐堂  (http://foxtable.com/bbs/list.asp?boardid=2)
----  导出EXCEL行合并问题  (http://foxtable.com/bbs/dispbbs.asp?boardid=2&id=176940)

--  作者：hongye
--  发布时间：2022/5/4 1:35:00
--  导出EXCEL行合并问题

如图：

此主题相关图片如下：01.jpg

以上是利用如下代码导出的EXCEL表格
Dim dt As Table = Tables("窗口3_Table1")
Dim nms() As String = {"客户编号", "面料名称", "色号", "颜色", "数量", "交货日期", "交货单位"} \'要导出的列名
Dim caps() As String = {"客户编号", "面料名称", "色号", "颜色", "数量", "交货日期", "交货单位"} \'对应的列标题
Dim szs() As Integer = {70, 130, 60, 65, 60, 120, 120} \'对应的列宽
Dim Book As New XLS.Book \'定义一个Excel工作簿
Dim Sheet As XLS.Sheet = Book.Sheets(0) \'引用工作簿的第一个工作表
Sheet(0, 0).Value = "交货明细"
Dim st1 As XLS.Style = Book.NewStyle
st1.BorderTop = XLS.LineStyleEnum.Thin
st1.BorderBottom = XLS.LineStyleEnum.Thin
st1.BorderLeft = XLS.LineStyleEnum.Thin
st1.BorderRight = XLS.LineStyleEnum.Thin
st1.BorderColorTop = Color.Black
st1.BorderColorBottom = Color.Black
st1.BorderColorLeft = Color.Black
st1.BorderColorRight = Color.Black
Sheet.Rows(0).Height = 40
Sheet.MergeCell(0, 0, 1, nms.length)
Sheet(0, 0).Style = st1
st1.AlignHorz = XLS.AlignHorzEnum.Center
st1.AlignVert = XLS.AlignVertEnum.Center
For c1 As Integer = 0 To nms.length - 1
Sheet(1, c1).Style = st1
Next
For r As Integer = 0 To dt.Rows.Count - 1
For c As Integer = 0 To nms.length - 1
If dt.Cols(nms(c)).IsDate = False Then
Sheet(r + 2, c).Style = St1
End If
Next
Next
For c As Integer = 0 To nms.length - 1
Sheet(1, c).Value = caps(c) \'指定列标题
Sheet.Cols(c).Width = szs(c) \'指定列宽
Sheet.Rows(1).Height = 30
Next
For c As Integer = 0 To nms.length - 1
For r As Integer = 0 To dt.Rows.Count - 1 \'填入数据
Sheet(r + 2, c).Value = dt.rows(r)(nms(c))
Sheet.Rows(r + 2).Height = 30
Next
Next
Dim st2 As XLS.Style = Book.NewStyle \'日期列的显示格式
st2.BorderTop = XLS.LineStyleEnum.Thin
st2.BorderBottom = XLS.LineStyleEnum.Thin
st2.BorderLeft = XLS.LineStyleEnum.Thin
st2.BorderRight = XLS.LineStyleEnum.Thin
st2.BorderColorTop = Color.Black
st2.BorderColorBottom = Color.Black
st2.BorderColorLeft = Color.Black
st2.BorderColorRight = Color.Black
st2.AlignHorz = XLS.AlignHorzEnum.Center
st2.AlignVert = XLS.AlignVertEnum.Center
st2.Format = "yyyy-MM-dd"
For c As Integer = 0 To nms.length - 1
For r As Integer = 0 To dt.Rows.Count - 1 \'填入数据
If dt.Cols(nms(c)).IsDate Then \'如果是日期列
Sheet(r + 2, c).Style = st2 \'设置显示格式
End If
Next
Next
Dim dlg As New SaveFileDialog \'定义一个新的SaveFileDialog
dlg.Filter = "Excel文件|*.xlsx" \'设置筛选器
If dlg.ShowDialog = DialogResult.Ok Then
Book.Save(dlg.FileName)
Dim Proc As New Process
Proc.File = dlg.FileName
Proc.Start()
End If

现在我需要导出的EXCEL表格自动合并相同值的行，代码怎么写？，如下图：

此主题相关图片如下：02.jpg

[此贴子已经被作者于2022/5/4 14:14:17编辑过]

--  作者：有点蓝
--  发布时间：2022/5/4 21:23:00
--

For c As Integer = 0 To nms.length - 1
For r As Integer = 0 To dt.Rows.Count - 1 \'填入数据
If dt.Cols(nms(c)).IsDate Then \'如果是日期列
Sheet(r + 2, c).Style = st2 \'设置显示格式
End If
Next
Next
改为
For c As Integer = 0 To nms.length - 1
dim m as integer = -1
dim n as string = dt.rows(0)(nms(c))
For r As Integer = 0 To dt.Rows.Count - 1 \'填入数据
Sheet.Rows(r + 2).Height = 30
if n = dt.rows(r)(nms(c)) then
if m=-1 then
m = r + 2
Sheet(r + 2, c).Value = dt.rows(r)(nms(c))
end if
else
Sheet.MergeCell(m, c, r + 1 - m, 1)
m = r + 2
end if
Next
n = dt.rows(r)(nms(c))
Next

[此贴子已经被作者于2022/5/4 21:22:58编辑过]

--  作者：hongye
--  发布时间：2022/5/5 0:02:00
--

Dim de As Table = Tables("统计")
Dim nms() As String = {"面料名称", "色号", "颜色", "数量", "交货日期", "交货单位", "合计"} \'要导出的列名
Dim caps() As String = {"面料名称", "色号", "颜色", "数量", "交货日期", "交货单位", "合计"} \'对应的列标题
Dim Book As New XLS.Book \'定义一个Excel工作簿
Dim Sheet As XLS.Sheet = Book.Sheets(0) \'引用工作簿的第一个工作表
With Sheet.PrintSetting \'打开打印设置对话框
.AutoScale = True \'自动缩放
.FitPagesAcross = 1 \'垂直方向缩为1页
End With
Dim Style As XLS.Style = Book.NewStyle() \'定义新样式
Dim styel1 As XLS.Style = Book.NewStyle() \'定义新样式
styel1.font = New Font("微软雅黑", 16)
Dim styel2 As XLS.Style = Book.NewStyle() \'定义新样式
styel2.font = New Font("微软雅黑", 12)
Style.BorderTop = XLS.LineStyleEnum.Thin \'设置上边框为细线
Style.BorderBottom = XLS.LineStyleEnum.Thin \'设置下边框为细线
Style.BorderLeft = XLS.LineStyleEnum.Thin \'设置左边框为细线
Style.BorderRight = XLS.LineStyleEnum.Thin \'设置右边框为细线
styel1.BorderTop = XLS.LineStyleEnum.Thin \'设置上边框为细线
styel1.BorderBottom = XLS.LineStyleEnum.Thin \'设置下边框为细线
styel1.BorderLeft = XLS.LineStyleEnum.Thin \'设置左边框为细线
styel1.BorderRight = XLS.LineStyleEnum.Thin \'设置右边框为细线
styel2.BorderTop = XLS.LineStyleEnum.Thin \'设置上边框为细线
styel2.BorderBottom = XLS.LineStyleEnum.Thin \'设置下边框为细线
styel2.BorderLeft = XLS.LineStyleEnum.Thin \'设置左边框为细线
styel2.BorderRight = XLS.LineStyleEnum.Thin \'设置右边框为细线
Style.BorderColorTop = Color.Black \'设置上边框细线颜色为黑色
Style.BorderColorBottom = Color.Black \'设置下边框细线颜色为黑色
Style.BorderColorLeft = Color.Black \'设置左边框细线颜色为黑色
Style.BorderColorRight = Color.Black \'设置右边框细线颜色为黑色
styel1.BorderColorTop = Color.Black \'设置上边框细线颜色为黑色
styel1.BorderColorBottom = Color.Black \'设置下边框细线颜色为黑色
styel1.BorderColorLeft = Color.Black \'设置左边框细线颜色为黑色
styel1.BorderColorRight = Color.Black \'设置右边框细线颜色为黑色
styel2.BorderColorTop = Color.Black \'设置上边框细线颜色为黑色
styel2.BorderColorBottom = Color.Black \'设置下边框细线颜色为黑色
styel2.BorderColorLeft = Color.Black \'设置左边框细线颜色为黑色
styel2.BorderColorRight = Color.Black \'设置右边框细线颜色为黑色
Sheet.Rows(0).Height = 70 \'设置第1行的行高
styel1.WordWrap = True \'单元格内容自动换行
styel2.AlignHorz = XLS.AlignHorzEnum.Center \'设置水平对齐方式居中
styel2.AlignVert = XLS.AlignVertEnum.Center \'设置垂直对齐方式居中
styel1.AlignHorz = XLS.AlignHorzEnum.Center \'设置水平对齐方式居中
styel1.AlignVert = XLS.AlignVertEnum.Center \'设置垂直对齐方式居中
Style.AlignHorz = XLS.AlignHorzEnum.Center \'设置水平对齐方式居中
Style.AlignVert = XLS.AlignVertEnum.Center \'设置垂直对齐方式居中
For c As Integer = 0 To nms.length - 1
Sheet(1, c).Value = caps(c) \'生成表头，指定列标题
Sheet.Rows(1).Height = 45 \'设置第1行的行高
Next
Sheet(0, 0).Value = "2022年秋冬面料订单" & vbcrlf & "订单明细" ‘生成表头标题
Dim dtd As DataTable = DataTables("统计") ‘定义临时箱单表
Dim idx As Integer = 0
For Each ck As String In dtd.GetValues("面料编号", "", "面料识别号,面料编号")
Dim Rows = dtd.Select("面料编号=\'" & ck & "\'", "面料识别号")
Sheet(idx + 2, 0).Value = "面料编号：" & ck
idx += 1 \'设置间隔
Dim mcount As Integer = 0
Dim msum As Integer = 0
For r As Integer = 0 To Rows.Count - 1 \'填入数据
If r > 0 Then
If Rows(r - 1)("面料名称") = Rows(r)("面料名称") Then
mcount += 1
msum += Rows(r - 1)("合计")
ElseIf mcount > 0 Then
Sheet.MergeCell(r + idx + 2 - mcount - 1, 0, mcount + 1, 1) \'合并单元格（面料名称）
Sheet.MergeCell(r + idx + 2 - mcount - 1, 6 + caps.count + 1, mcount + 1, 1) \'合并单元格（合计）
Sheet(r + idx + 2 - mcount - 1, 6 + caps.count + 1).Value = msum
mcount = 0
msum = Rows(r)("合计")
Else
msum = Rows(r)("合计")
End If
Else
msum = Rows(r)("合计")
End If
For c As Integer = 2 To de.Cols.Count - 1
Sheet.Cols(0).Width = 130
Sheet.Cols(1).Width = 70
Sheet.Cols(2).Width = 100
Sheet.Cols(3).Width = 70
Sheet.Cols(4).Width = 120
Sheet.Cols(5).Width = 150
Sheet.Cols(6).Width = 80
\' Sheet.Cols(7).Width = 120
\' Sheet.Cols(8).Width = 70
Sheet(0, 0).Style = styel1
Sheet.MergeCell(0, 0, 1, c - 1)
Sheet.MergeCell(idx + 1, 0, 1, c - 1)
If rows(r)(de.cols(c).name) = Nothing Then
Sheet(r + idx + 2 , c - 2).Value = Nothing
Else
Sheet(r + idx + 2 , c - 2).Value = rows(r)(de.cols(c).name)
End If
Sheet(r + idx + 2, c - 2).Style = Style
Sheet(0, c - 2).Style = Style
Sheet(1, c - 2).Style = Style
Sheet(1, c - 2).Style = styel2
\' Sheet(2, c).Style = styel2
Dim st2 As XLS.Style = Book.NewStyle \'日期列的显示格式
st2.BorderTop = XLS.LineStyleEnum.Thin
st2.BorderBottom = XLS.LineStyleEnum.Thin
st2.BorderLeft = XLS.LineStyleEnum.Thin
st2.BorderRight = XLS.LineStyleEnum.Thin
st2.BorderColorTop = Color.Black
st2.BorderColorBottom = Color.Black
st2.BorderColorLeft = Color.Black
st2.BorderColorRight = Color.Black
st2.AlignHorz = XLS.AlignHorzEnum.Center
st2.AlignVert = XLS.AlignVertEnum.Center
st2.Format = "yyyy-MM-dd"
If de.Cols(nms(c - 2)).IsDate Then \'如果是日期列
Sheet(r + idx + 2 , c - 2).Style = st2 \'设置显示格式
End If
Next
Next
idx += Rows.Count
Next

Dim dlg As New SaveFileDialog \'定义一个新的SaveFileDialog
dlg.Filter = "Excel文件|*.xlsx" \'设置筛选器
If dlg.ShowDialog = DialogResult.Ok Then
Book.Save(dlg.FileName)
Dim Proc As New Process
Proc.File = dlg.FileName
Proc.Start()
End If

此主题相关图片如下：01.jpg

此主题相关图片如下：02.jpg

请帮忙改一下吧，真的不懂了

--  作者：有点蓝
--  发布时间：2022/5/5 8:29:00
--
请上传实例测试

--  作者：hongye
--  发布时间：2022/5/5 10:10:00
--

下载信息  [文件大小：   下载次数： ]
点击浏览该文件:面料系统.rar

--  作者：有点蓝
--  发布时间：2022/5/5 15:22:00
--

下载信息  [文件大小：   下载次数： ]
点击浏览该文件:面料系统.zip