以文本方式查看主题

-  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=102185)

--  作者:abc2363360
--  发布时间:2017/6/14 17:07:00
--  excel数据更新到项目的问题

更新规则:
用   <1111.xlsx > 中的
 "工单号或受理人"的内容查询项目中是否存在,
如果存在,则更新 "受理时间"  "外呼时间" "录入时间" 

   如果不存在,则整行新增到项目内

 

点击按钮1弹出选择要更新有文件  选择好后确认  提示确认导入

更新完成提示更新了多少条数据

完成后提示新增多少条数据

 

以下是现有的代码,但是不能弹出选择文件,导入时间只显示日期,时间都是00,麻烦大神帮忙修改一下

Dim Book As New XLS.Book("C:\\1111.xlsx")
Dim Sheet As XLS.Sheet = Book.Sheets(0)
Tables("商机单跟进表").StopRedraw()
Dim nms() As String = {"受理时间","外呼时间","录入时间"}

Dim s1 As new List(of String)
s1.AddRange(nms)
Dim dict As new Dictionary(of String,Integer)
Dim dict2 As new Dictionary(of String,Integer)
For m As Integer = 0 To sheet.Cols.count -1
    If s1.Contains(sheet(0,m).value) Then
        dict.add(sheet(0,m).value,m)
    End If
    If DataTables("商机单跟进表").DataCols.Contains(sheet(0,m).value) Then
        dict2.add(sheet(0,m).value,m)
    End If
Next

For n As Integer = 1 To Sheet.Rows.Count -1
    Dim bh As String = sheet(n,3).Text
    Dim dr As DataRow = DataTables("商机单跟进表").Find("工单号或受理人 = \'" & bh & "\'")
    If dr Is Nothing Then \'如果不存在同编号的订单
        dr =  DataTables("商机单跟进表").AddNew()
        For Each key As String In dict2.Keys
            dr(key) = Sheet(n,dict2(key)).Value
        Next
    Else
        For Each mm As String In nms
            dr(mm) = Sheet(n,dict(mm)).Value
        Next
    End If
   
Next
Tables("商机单跟进表").ResumeRedraw()


--  作者:abc2363360
--  发布时间:2017/6/14 17:08:00
--  
 下载信息  [文件大小:   下载次数: ]
图片点击可在新窗口打开查看点击浏览该文件:1111.xlsx

 下载信息  [文件大小:   下载次数: ]
图片点击可在新窗口打开查看点击浏览该文件:数据合并.foxdb


--  作者:有点色
--  发布时间:2017/6/14 17:49:00
--  
Dim dlg As new OpenFileDialog
dlg.Filter = "excel文件|*.xls;*.xlsx"
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(1)
       
        Tables("商机单跟进表").StopRedraw()
        Dim nms() As String = {"受理时间","外呼时间","录入时间"}
       
        Dim dict As new Dictionary(of String,Integer)
        Dim dict2 As new Dictionary(of String,Integer)
        Dim Rg As MSExcel.Range = Ws.UsedRange
        Dim ary = rg.value
        For c As Integer = 1 To rg.Columns.Count
            If array.Indexof(nms, ary(1, c)) >= 0 Then
                dict.add(ary(1, c), c)
            End If
            If Tables("商机单跟进表").Cols.Contains(ary(1,c)) Then
                dict2.add(ary(1, c), c)
            End If
        Next
        Dim newcount As Integer = 0
        Dim Modifycount As Integer = 0
        For n As Integer = 2 To rg.Rows.count
            Dim bh As String = ary(n, 4)
            Dim dr As DataRow = DataTables("商机单跟进表").Find("工单号或受理人 = \'" & bh & "\'")
            If dr Is Nothing Then \'如果不存在同编号的订单
                dr =  DataTables("商机单跟进表").AddNew()
                For Each key As String In dict2.Keys
                    dr(key) = ary(n,dict2(key))
                Next
                newcount += 1
            Else
                For Each key As String In dict.Keys
                    dr(key) = ary(n,dict(key))
                Next
                Modifycount += 1
            End If
           
        Next
        Tables("商机单跟进表").ResumeRedraw()
        msgbox(newcount & "   " & Modifycount)
    catch ex As exception
        msgbox(ex.message)
        app.quit
    End try
End If

--  作者:采菊东篱下
--  发布时间:2024/3/14 23:09:00
--  
回错了地方,不好意思。

[此贴子已经被作者于2024/3/14 23:13:47编辑过]