Foxtable(狐表)用户栏目专家坐堂 → 导出EXCEL行合并问题


  共有4690人关注过本帖树形打印复制链接

主题:导出EXCEL行合并问题

帅哥哟,离线,有人找我吗?
hongye
  1楼 | 信息 | 搜索 | 邮箱 | 主页 | UC


加好友 发短信
等级:一尾狐 帖子:437 积分:2949 威望:0 精华:0 注册:2011/3/15 12:49:00
导出EXCEL行合并问题  发帖心情 Post By:2022/5/4 1:35:00 [只看该作者]

如图:

图片点击可在新窗口打开查看此主题相关图片如下: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编辑过]

 回到顶部
帅哥哟,离线,有人找我吗?
有点蓝
  2楼 | 信息 | 搜索 | 邮箱 | 主页 | UC


加好友 发短信
等级:超级版主 帖子:110738 积分:563610 威望:0 精华:9 注册:2015/6/24 9:21:00
  发帖心情 Post By: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
  3楼 | 信息 | 搜索 | 邮箱 | 主页 | UC


加好友 发短信
等级:一尾狐 帖子:437 积分:2949 威望:0 精华:0 注册:2011/3/15 12:49:00
  发帖心情 Post By: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
图片点击可在新窗口打开查看

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




 回到顶部
帅哥哟,离线,有人找我吗?
有点蓝
  4楼 | 信息 | 搜索 | 邮箱 | 主页 | UC


加好友 发短信
等级:超级版主 帖子:110738 积分:563610 威望:0 精华:9 注册:2015/6/24 9:21:00
  发帖心情 Post By:2022/5/5 8:29:00 [只看该作者]

请上传实例测试

 回到顶部
帅哥哟,离线,有人找我吗?
hongye
  5楼 | 信息 | 搜索 | 邮箱 | 主页 | UC


加好友 发短信
等级:一尾狐 帖子:437 积分:2949 威望:0 精华:0 注册:2011/3/15 12:49:00
  发帖心情 Post By:2022/5/5 10:10:00 [只看该作者]

 下载信息  [文件大小:   下载次数: ]
图片点击可在新窗口打开查看点击浏览该文件:面料系统.rar


 回到顶部
帅哥哟,离线,有人找我吗?
有点蓝
  6楼 | 信息 | 搜索 | 邮箱 | 主页 | UC


加好友 发短信
等级:超级版主 帖子:110738 积分:563610 威望:0 精华:9 注册:2015/6/24 9:21:00
  发帖心情 Post By:2022/5/5 15:22:00 [只看该作者]

 下载信息  [文件大小:   下载次数: ]
图片点击可在新窗口打开查看点击浏览该文件:面料系统.zip


 回到顶部