共5 条记录, 每页显示 10 条, 页签:
[1]
[浏览完整版]
标题：[求助]工作薄的多个表导入到foxtable的多个表工作薄频繁打开
1楼
18107532666 发表于：2025/3/30 17:18:00求教老师：我提取一个工作薄中的多个工作表数据到foxtable对应的多个表（可以是EXECL和WPS打开），但在代码执行过程中每提取一个工作的数据工作薄就打开次一次，进程中有多个，如何打开一次就可以了，老师给看看是什么问题
'1.打开要提取数据的工作薄
Dim dlg As New OpenFileDialog '定义一个新的OpenFileDialog
dlg.Filter = "excel文件|*.xlsx; *.xls;*.xlsm" '设置筛选器
If dlg.ShowDialog = DialogResult.Ok Then '如果用户单击了确定按钮
Dim dtb As New DataTableBuilder(FileSys.GetName(dlg.FileName))'定义dtb为新的临时表
End If
'2.设置不需要提取数据的固定工作表
Dim excludeSheets As New List(Of String)'定义一个集合
excludeSheets.Add("产值汇总表")'增加工作表名称
excludeSheets.Add("量价差汇总")'增加工作表名称
excludeSheets.Add("劳务费用分劈表控制")'增加工作表名称
excludeSheets.Add("工程量汇总")'增加工作表名称
excludeSheets.Add("对下计价台账控制")'增加工作表名称
excludeSheets.Add("对下计价台账业务")'增加工作表名称
excludeSheets.Add("工程量汇总旧")'增加工作表名称
'3启动一个隐藏的Excel进程，能够通过代码自动化操作Excel
Dim App As New MSExcel.Application
'App.Visible = True'execl表可见
'4.定义工作薄和工作表
Dim Wb As MSExcel.WorkBook = App.WorkBooks.Open(dlg.FileName)'定义wb为工作薄
Dim book As New XLS.Book(dlg.FileName) '定义一个Excel工作簿
Dim Sheet As XLS.Sheet '定义工作表
'5.遍历要提取数据的工作表
For Each sheet In book.Sheets'在工作表中遍历
Dim sheetName As String = sheet.Name.Trim() '取工作表名并前后去空格
If excludeSheets.Contains(sheetName) = False AndAlso sheetName.Contains("业务") = False Then'固定表名称不包括本表名称和工作表名不包含业务
' 创建对应Foxtable结构
Dim dt As New DataTableBuilder(sheetname)'用工作表名创建临时表
dt.AddDef("编码", GetType(String), 50)
dt.AddDef("开累已计价数量", GetType(Double), 50)
dt.AddDef("开累应计未计数量", GetType(Double), 50)
dt.AddDef("开累已计价金额", GetType(Double), 50)
dt.AddDef("序号", GetType(String), 50)
dt.AddDef("项目内容", GetType(String), 200)
dt.AddDef("单位", GetType(String), 50)
dt.Build()
MainTable = Tables(sheetname)
' 读取Excel数据
Dim Ws As MSExcel.WorkSheet = Wb.WorkSheets(sheetName)'定义ws为工作表
'从下向上查找最后一个行并得到其行号.
Dim FirstRow As Integer = ws.Range("E2000").End(MSExcel.XlDirection.xlup).Row
'对A列从第1行开始向下查找,直到找到最后一个非空单元格为止,并得到其行号.也就是有内容的开始行
Dim Rg As MSExcel.Range = ws.UsedRange
Dim ary = rg.value
Dim bb2 As Integer = FirstRow 'Sheet2.Rows.Count
'填充数据
For n As Integer = 5 To bb2 '5代表从工作表第5行开始逐行遍历’
Dim ro As Row = Tables(sheetname).AddNew '新增一行’
For i As Integer = 1 To 7 '1代表从第一个列开始读取’
ro(i - 1) = ary(n, i) 'i + 2代表数据从第三列后开始填充’
Next
Next
End If
Next
[此贴子已经被作者于2025/3/30 17:48:19编辑过]
2楼
有点蓝 发表于：2025/3/30 21:00:00试试
'1.打开要提取数据的工作薄
Dim dlg As New OpenFileDialog '定义一个新的OpenFileDialog
dlg.Filter = "excel文件|*.xlsx; *.xls;*.xlsm" '设置筛选器
If dlg.ShowDialog = DialogResult.Ok Then '如果用户单击了确定按钮
'2.设置不需要提取数据的固定工作表
Dim excludeSheets As New List(Of String)'定义一个集合
excludeSheets.Add("产值汇总表")'增加工作表名称
excludeSheets.Add("量价差汇总")'增加工作表名称
excludeSheets.Add("劳务费用分劈表控制")'增加工作表名称
excludeSheets.Add("工程量汇总")'增加工作表名称
excludeSheets.Add("对下计价台账控制")'增加工作表名称
excludeSheets.Add("对下计价台账业务")'增加工作表名称
excludeSheets.Add("工程量汇总旧")'增加工作表名称
'3启动一个隐藏的Excel进程，能够通过代码自动化操作Excel
Dim App As New MSExcel.Application
'App.Visible = True'execl表可见
'4.定义工作薄和工作表
Dim Wb As MSExcel.WorkBook = App.WorkBooks.Open(dlg.FileName)'定义wb为工作薄
'5.遍历要提取数据的工作表
For Each sheet As MSExcel.WorkSheet In Wb.WorkSheets '在工作表中遍历
Dim sheetName As String = sheet.Name.Trim() '取工作表名并前后去空格
If excludeSheets.Contains(sheetName) = False AndAlso sheetName.Contains("业务") = False Then'固定表名称不包括本表名称和工作表名不包含业务
' 创建对应Foxtable结构
Dim dt As New DataTableBuilder(sheetname)'用工作表名创建临时表
dt.AddDef("编码", GetType(String), 50)
dt.AddDef("开累已计价数量", GetType(Double), 50)
dt.AddDef("开累应计未计数量", GetType(Double), 50)
dt.AddDef("开累已计价金额", GetType(Double), 50)
dt.AddDef("序号", GetType(String), 50)
dt.AddDef("项目内容", GetType(String), 200)
dt.AddDef("单位", GetType(String), 50)
dt.Build()
'MainTable = Tables(sheetname)
Tables(sheetname).StopRedraw
'从下向上查找最后一个行并得到其行号.
Dim FirstRow As Integer = sheet.Range("E2000").End(MSExcel.XlDirection.xlup).Row
'对A列从第1行开始向下查找,直到找到最后一个非空单元格为止,并得到其行号.也就是有内容的开始行
Dim Rg As MSExcel.Range = sheet.UsedRange
Dim ary = rg.value
Dim bb2 As Integer = FirstRow 'Sheet2.Rows.Count
'填充数据
For n As Integer = 5 To bb2 '5代表从工作表第5行开始逐行遍历’
Dim ro As Row = Tables(sheetname).AddNew '新增一行’
For i As Integer = 1 To 7 '1代表从第一个列开始读取’
ro(i - 1) = ary(n, i) 'i + 2代表数据从第三列后开始填充’
Next
Next
Tables(sheetname).ResumeRedraw
End If
Next
Wb.Close
App.quit
End If
3楼
18107532666 发表于：2025/3/30 21:55:00
此主题相关图片如下：微信图片_20250330215339.png
4楼
18107532666 发表于：2025/3/30 21:56:00弹出这个
5楼
有点蓝 发表于：2025/3/30 22:36:00加上
wb.saved = True
App.DisplayAlerts = False
共5 条记录, 每页显示 10 条, 页签:
[1]