以文本方式查看主题

-  Foxtable(狐表)  (http://foxtable.net/bbs/index.asp)
--  专家坐堂  (http://foxtable.net/bbs/list.asp?boardid=2)
----  杂项导入合并都没问题,自写导入提示错误  (http://foxtable.net/bbs/dispbbs.asp?boardid=2&id=87050)

--  作者: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:55:00
--  

错误提示很清楚,有些数据不是数字,不能写入数值列。

菜单中的合并,会自动排除非法数据,自己编码合并的话,要自己判断数据是否合法。


--  作者:大红袍
--  发布时间: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编辑过]

--  作者:sf020cf
--  发布时间:2016/7/1 18:22:00
--  

数量列中确定没有非数字字符


--  作者:大红袍
--  发布时间:2016/7/1 19:05:00
--  
 看3楼。你excel的数量列,有不正确的数据。