- 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)
-- 发布时间：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()
-- 发布时间：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
--