专家坐堂-[求助]关于合并导入Excel代码优化Foxtable(狐表) - 新一代数据库软件，完美融合Access、Foxpro、Excel、vb.net之优势，人人都能掌握的快速软件开发工具!

以文本方式查看主题

-  Foxtable(狐表)  (http://foxtable.net/bbs/index.asp)
--  专家坐堂  (http://foxtable.net/bbs/list.asp?boardid=2)
----  [求助]关于合并导入Excel代码优化  (http://foxtable.net/bbs/dispbbs.asp?boardid=2&id=48737)

--  作者：neha
--  发布时间：2014/4/4 8:18:00
--  [求助]关于合并导入Excel代码优化

Dim dlg As New OpenFileDialog \'定义一个新的OpenFileDialog
dlg.Filter= "Excel文件|*.xls" \'设置筛选器
If dlg.ShowDialog = DialogResult.Ok Then \'如果用户单击了确定按钮
e.Sender.Text = "导入中……"
Dim Book As New XLS.Book(dlg.FileName)
Dim Sheet As XLS.Sheet = Book.Sheets(0)
\'Tables("入库明细表").StopRedraw()
\'注意以下数组中列名称的顺序,必须和Excel表中的列顺序一致
Dim nms() As String = {"窑号","窑洞","数量","单位","出窑人","担当","录入时间","验收时间","商品名"}
Application.DoEvents
\'注意下面的循环变量从1开始,而不是从0开始,因为Excel表的第一行是标题
For n As Integer = 1 To Sheet.Rows.Count -1
Dim bh As String = "窑号 =\'" & sheet(n,0).Text & "\' and 窑洞 = " & sheet(n,1).Text & " and 数量 = " & sheet(n,3).Text & " and 出窑人 = \'" & sheet(n,5).Text & "\' and 验收时间 = #" & sheet(n,6).Text & "# and 商品名 = \'" & sheet(n,2).Text & "\'"
If DataTables("入库明细表").sqlFind(bh) Is Nothing Then \'如果不存在同编号的订单
Dim r As Row = Tables("入库明细表").AddNew()
For m As Integer = 0 To nms.Length - 1
r(nms(m)) = Sheet(n,m).Value
Next
End If

Next
e.Sender.Text = "导入"
Tables("入库明细表").ResumeRedraw()




\'Dim dtb As New DataTableBuilder("导入临时表")
\'dtb.AddDef("窑号", Gettype(String), 5)
\'dtb.AddDef("窑洞", Gettype(Short))
\'dtb.AddDef("商品名", Gettype(String), 8)
\'dtb.AddDef("数量", Gettype(Integer))
\'dtb.AddDef("单位", Gettype(String), 2)
\'dtb.AddDef("出窑人", Gettype(String), 5)
\'dtb.AddDef("验收时间", Gettype(Date))
\'dtb.AddDef("录入时间", Gettype(Date))
\'dtb.AddDef("担当", Gettype(String), 5)
\'dtb.TableVisible=False
\'dtb.Build
\'
\'Dim mg As New Merger
\'mg.SourcePath = dlg.FileName
\'mg.Format = "excel" \'指定格式
\'mg.SourceTableName = "导出的临时数据$" \'指定要合并的表
\'mg.DataTableName = "入库明细表" \'指定接收数据的表
\'mg.Merge() \'开始合并
\'
\'\'Dim f As New Filler
\'\'f.SourceTable = DataTables("导入临时表") \'指定数据来源
\'\'f.DataTable = DataTables("入库明细表") \'指定数据接收表
\'\'f.ExcludeExistValue = True
\'\'f.Fill() \'填充数据
\'

End If

这段代码如何优化，现在是运行代码就要很长时间

--  作者：Bin
--  发布时间：2014/4/4 8:27:00
--
大量的并且多条件的 sqlFind 效率肯定不会高

如果是外部数据源,可以设置一下索引看看.

--  作者：jspta
--  发布时间：2014/4/4 9:26:00
--

Dim dlg As New OpenFileDialog \'定义一个新的OpenFileDialog
dlg.Filter= "Excel文件|*.xls" \'设置筛选器
If dlg.ShowDialog = DialogResult.Ok Then \'如果用户单击了确定按钮
e.Sender.Text = "导入中……"
Dim Book As New XLS.Book(dlg.FileName)
Dim Sheet As XLS.Sheet = Book.Sheets(0)
\'Tables("入库明细表").StopRedraw()
\'注意以下数组中列名称的顺序,必须和Excel表中的列顺序一致
Dim nms() As String = {"窑号","窑洞","数量","单位","出窑人","担当","录入时间","验收时间","商品名"}
Application.DoEvents
\'注意下面的循环变量从1开始,而不是从0开始,因为Excel表的第一行是标题
Dim arrTemp As object = Sheet.UsedRange.value
dim cmd as new sqlcommand
cmd.commandtext = "Select distinct 窑号,窑洞,数量,出窑人 ,验收时间 ,商品名 from 入库明细表"
dim dt as datatable = cmd.ExecuteReader
For n As Integer = 0 To arrTemp.Length -1
Dim bh As String = "窑号 =\'" & arrTemp(n,0).Text & "\' and 窑洞 = " & arrTemp(n,1).Text & " and 数量 = " & arrTemp(n,3).Text & " and 出窑人 = \'" & arrTemp(n,5).Text & "\' and 验收时间 = #" & arrTemp(n,6).Text & "# and 商品名 = \'" & arrTemp(n,2).Text & "\'"
\'如果以下这段还需要很多时间，就先用一个数组保存，然后一起添加行addnew(XX)再循环
If dt.Find(bh) Is Nothing Then \'如果不存在同编号的订单
Dim r As Row = Tables("入库明细表").AddNew() \' 最耗时的是这句
For m As Integer = 0 To nms.Length - 1
r(nms(m)) = arrTemp(n,m).Value
Next
End If
Next
e.Sender.Text = "导入"
Tables("入库明细表").ResumeRedraw()

End If

这段代码如何优化，现在是运行代码就要很长时间

--  作者：Bin
--  发布时间：2014/4/4 9:32:00
--
主要耗时应该在FIND条件上.尝试
dt.find("窑号 =\'\'")
Dim bh As String = "窑号 =\'" & arrTemp(n,0).Text & "\' and 窑洞 = " & arrTemp(n,1).Text & " and 数量 = " & arrTemp(n,3).Text & " and 出窑人 = \'" & arrTemp(n,5).Text & "\' and 验收时间 = #" & arrTemp(n,6).Text & "# and 商品名 = \'" & arrTemp(n,2).Text & "\'"
f dt.Find(bh) Is Nothing Then \'如果不存在同编号的订单

--  作者：Neha
--  发布时间：2014/4/4 9:56:00
--

---------------------------
错误
---------------------------
编译错误:“UsedRange”不是“XLS.Sheet”的成员。

错误代码：Dim arrTemp As object = Sheet.UsedRange.value
---------------------------
确定
---------------------------

--  作者：Bin
--  发布时间：2014/4/4 9:58:00
--
试试4楼的方案.

--  作者：Neha
--  发布时间：2014/4/4 13:44:00
--
好了
sqlfind 和 find 差距那么大吗
Dim st As Date = Date.Now
\'要测试耗时的代码
Dim dlg As New OpenFileDialog \'定义一个新的OpenFileDialog

dlg.Filter= "Excel文件|*.xls" \'设置筛选器
If dlg.ShowDialog = DialogResult.Ok Then \'如果用户单击了确定按钮
e.Sender.Text = "导入中……"
Dim count As Integer
Dim Book As New XLS.Book(dlg.FileName)
Dim Sheet As XLS.Sheet = Book.Sheets(0)
Application.DoEvents
Tables(e.Form.name & "_明细表").StopRedraw
Tables("入库明细表").StopRedraw()
\'注意以下数组中列名称的顺序,必须和Excel表中的列顺序一致
Dim nms() As String = {"窑号","窑洞","商品名","数量","单位","出窑人","验收时间","录入时间","担当"}
Dim cmd As new sqlcommand
cmd.C
cmd.commandtext = "Select distinct 窑号,窑洞,数量,出窑人,验收时间,商品名 from {入库明细表}"
Dim dt As DataTable = cmd.ExecuteReader

\'注意下面的循环变量从1开始,而不是从0开始,因为Excel表的第一行是标题
For n As Integer = 1 To Sheet.Rows.Count -1
Dim bh As String = "窑号 =\'" & sheet(n,0).Text & "\' and 窑洞 = " & sheet(n,1).Text & " and 数量 = " & sheet(n,3).Text & " and 出窑人 = \'" & sheet(n,5).Text & "\' and 验收时间 = #" & sheet(n,6).Text & "# and 商品名 = \'" & sheet(n,2).Text & "\'"
Output.Show(bh)
If dt.Find(bh) Is Nothing Then \'如果不存在同编号的订单
Dim r As Row = Tables("入库明细表").AddNew()
For m As Integer = 0 To nms.Length - 1
r(nms(m)) = Sheet(n,m).Value
Next
count = count + 1
End If

Next
e.Sender.Text = "导入"
Tables(e.Form.name & "_明细表").ResumeRedraw()
Tables("入库明细表").ResumeRedraw()
Tables("入库明细表").DataTable.Save
MessageBox.Show("导入成功!" & vbcrlf & "总共导入" & count & "条数据耗时: " & (Date.Now - st).TotalSeconds & "秒")

End If

--  作者：有点甜
--  发布时间：2014/4/4 13:51:00
--

sqlfind 的话，一般是在使用频率不高的情况下使用的。因为每次连接数据库都需要开销

如果需要多次查询的话，最好先把所有数据都拿出来，再查找

--  作者：Neha
--  发布时间：2014/4/4 17:25:00
--
为什么导入到狐表以后，2014-04-04 08:39变成2014-04-04 00：00了怎么得到正确的导入

--  作者：Bin
--  发布时间：2014/4/4 17:27:00
--
狐表里的时间格式正确吗?

Sheet(n,m).Value 取值的时候弹出来看看是否正常,

自己分析不出,就上个例子看看.