Foxtable(狐表)用户栏目专家坐堂 → execl导入合并的问题


  共有3446人关注过本帖树形打印复制链接

主题:execl导入合并的问题

帅哥哟,离线,有人找我吗?
有点蓝
  1楼 | 信息 | 搜索 | 邮箱 | 主页 | UC


加好友 发短信
等级:超级版主 帖子:110738 积分:563610 威望:0 精华:9 注册:2015/6/24 9:21:00
  发帖心情 Post By:2015/8/30 20:28:00 [显示全部帖子]

水平有限仅供参考,看看这样行不行,是不是快点了
Dim dlg As new OpenFileDialog
dlg.MultiSelect = True
If dlg.ShowDialog = DialogResult.OK Then
    For Each f As String In dlg.FileNames
        Dim  Book As New XLS.Book(f)
        Dim Sheet As XLS.Sheet = Book.Sheets(0)
        Dim dic As new Dictionary(Of String, Integer)
        For i As Integer = 0 To sheet.Cols.Count - 1
            If sheet(0,i).Text <> Nothing
                dic.Add(sheet(0,i).Text,i)
            End If
        Next
        Dim dic2 As new Dictionary(Of DataRow,Integer)
        For  n As Integer = 1 To Sheet.Rows.Count -1
            If sheet(n, dic("入住时间")).Text > "" Then
                Dim filter As String = "入住时间 = #" & sheet(n, dic("入住时间")).Text & "# and 姓名 = '" & sheet(n, dic("姓名")).Text & "' and 房间号 = '" & sheet(n, dic("房间号")).Text & "'"
                Dim dr As DataRow =  DataTables("表A").find(filter)
                If dr Is Nothing Then dr = DataTables("表A").AddNew
                dic2.Add(dr,n)
            End If
        Next
        For Each dr As DataRow In dic2.Keys
            For Each c As String In dic.Keys
                If DataTables("表A").datacols.Contains(c) Then
                    dr(c) = sheet(dic2(dr), dic(c)).Text
                End If
            Next
        Next
    Next    
End If


 回到顶部