-- 作者:sf020cf
-- 发布时间:2016/7/1 17:24:00
-- 杂项导入合并都没问题,自写导入提示错误
Dim dlg As new OpenFileDialog If dlg.ShowDialog = DialogResult.OK Then Dim App As New MSExcel.Application try Dim Wb As MSExcel.WorkBook = App.WorkBooks.Open(dlg.FileName) Dim Ws As MSExcel.WorkSheet = Wb.WorkSheets("计划表") wb.saved = True Dim Rg As MSExcel.Range = Ws.UsedRange Dim ary = rg.value Tables("订单").ResumeRedraw() Tables("订单").StopRedraw() Dim nms() As String = {"甲方客户","项目","下单日期","MK号","DO号","城市","客户","送货地址","物料代码","数量","体积","重量","承运商","司机","车牌","车数","车型","出车日期","车辆属性","备注","特殊要求","司机搬运费","跟车搬运","人数","订单编号"} Dim count As Integer = 0 Dim ls As new List(of Integer) Dim dic As new Dictionary (Of DataRow, Integer) systemready = False For i As Integer = 2 To Rg.Rows.count If ary(i, 25) > "" Then Dim Filter = "[订单编号] = \'" & ary(i,25) & "\'" Dim dr As DataRow = DataTables("订单").sqlFind(filter) If dr Is Nothing Then ls.Add(i) count += 1 Else dic.add(dr, i) End If End If Next For Each n As Integer In ls Dim r As Row = Tables("订单").AddNew() For m As Integer = 0 To nms.Length - 1 If ary(n,m+1) = Nothing Then r(nms(m)) = Nothing Else If Tables("订单").Cols(nms(m)).IsDate Then Dim d As Date If Date.TryParse(ary(n,m+1), d) r(nms(m)) = d End If Else r(nms(m)) = ary(n,m+1) End If End If Next Next systemready = True Tables("订单").ResumeRedraw() msgbox("共有 "& count &" 条数据导入" ) Tables("订单").Save catch ex As exception msgbox(ex.message) finally app.quit End try End If
以上为导入代码,一直提示:见图 我在原始数据中找了很久也没有这<> 用合并可以 这是为什么 此主题相关图片如下:2016-07-01_172224.jpg
|
-- 作者:大红袍
-- 发布时间:2016/7/1 17:58:00
--
If Tables("订单").Cols(nms(m)).IsDate Then Dim d As Date If Date.TryParse(ary(n,m+1), d) r(nms(m)) = d End If Else r(nms(m)) = ary(n,m+1) End If
改成
If Tables("订单").Cols(nms(m)).IsDate Then Dim d As Date If Date.TryParse(ary(n,m+1), d) r(nms(m)) = d End If ElseIf Tables("订单").Cols(nms(m)).Is IsNumeric Then r(nms(m)) = val(ary(n,m+1)) Else r(nms(m)) = ary(n,m+1) End If
[此贴子已经被作者于2016/7/1 17:57:45编辑过]
|