以文本方式查看主题

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

--  作者:李孝春
--  发布时间:2019/2/14 11:30:00
--  求助:关于合并数据,怎么实现EXCEL表格跨列或者指定的列数据导入呢?

求助:关于合并数据,怎么实现EXCEL表格跨列或者指定的列数据导入呢?

excel中有案件编号  案件类别  姓名  承办部门  承办人  承办日期  承办结果

但是实际使用中我只需要案件编号  姓名    承办结果

怎么实现跨列导入?并且比配案件基本信息表中的   案件编号  姓名   处理结果


Dim dlg As New OpenFileDialog \'定义一个新的OpenFileDialog

dlg.Filter= "Excel文件|*.xls|Access文件|*.mdb" \'设置筛选器

If dlg.ShowDialog = DialogResult.Ok Then \'如果用户单击了确定按钮

    Dim Book As New XLS.Book(dlg.FileName)

    Dim Sheet As XLS.Sheet = Book.Sheets(0)

    Tables("案件基本信息").StopRedraw()

    Dim nms() As String = {"案件编号","姓名"}

    For n As Integer = 1 To Sheet.Rows.Count -1

        Dim bh As String = sheet(n,0).Text

        Dim dr As DataRow = DataTables("案件基本信息").Find("案件编号 = \'" & bh & "\'")

        If dr Is Nothing Then \'如果不存在同编号的订单

            dr =  DataTables("案件基本信息").AddNew()

        End If

        For m As Integer = 0 To nms.Length - 1

            dr(nms(m)) = Sheet(n,m).Value

        Next

    Next

    Tables("案件基本信息").ResumeRedraw()

End If

[此贴子已经被作者于2019/2/14 11:32:54编辑过]

--  作者:有点甜
--  发布时间:2019/2/14 12:18:00
--  

参考

 

http://www.foxtable.com/bbs/dispbbs.asp?BoardID=2&ID=101056&skin=0

 


--  作者:李孝春
--  发布时间:2019/2/14 12:55:00
--  回复:(有点甜)参考 http://www.foxtable....

有点甜老师   操作不得要领呢
 下载信息  [文件大小:   下载次数: ]
图片点击可在新窗口打开查看点击浏览该文件:信息自动化.foxdb

 下载信息  [文件大小:   下载次数: ]
图片点击可在新窗口打开查看点击浏览该文件:公诉信息表.xls

 下载信息  [文件大小:   下载次数: ]
图片点击可在新窗口打开查看点击浏览该文件:批捕信息表.xls

在主窗体中我写入了导入事件代码:可以实现数据导入
但是数据不能按照指定的列进入指定的数据表里
出现了错乱
有木有办法导入EXCEL表中我对应指定的列值,且对应到表中对应的列值呢?多余的部分不用导入。

代码如下:
DataTables("案件基本信息").AllowEdit= True
Dim dlg As New OpenFileDialog \'定义一个新的OpenFileDialog
dlg.Filter= "Excel文件|*.xls" \'设置筛选器
If dlg.ShowDialog = DialogResult.Ok Then \'如果用户单击了确定按钮
    Dim Book As New XLS.Book(dlg.FileName)
    Dim Sheet As XLS.Sheet = Book.Sheets(0)
    Tables("案件基本信息").StopRedraw()
    Dim nms() As String = {"部门受案号","嫌疑人姓名","受理日期","涉嫌案由"}
    For n As Integer = 1 To Sheet.Rows.Count -1
        Dim bh As String = sheet(n,0).Text
        Dim dr As DataRow = DataTables("案件基本信息").Find("部门受案号 = \'" & bh & "\'")
        If dr Is Nothing Then \'如果不存在同编号的订单
            dr =  DataTables("案件基本信息").AddNew()
        End If
        For m As Integer = 0 To nms.Length - 1
            dr(nms(m)) = Sheet(n,m).Value
        Next
    Next
    Tables("案件基本信息").ResumeRedraw()
End If

--  作者:有点甜
--  发布时间:2019/2/14 15:24:00
--  
Dim dlg As New OpenFileDialog
dlg.Filter = "Excel文件|*.xls;*.xlsx"
If dlg.ShowDialog =DialogResult.OK Then
    Dim t As Table = Tables("案件基本信息")
    t.StopRedraw()
    Dim Book As New XLS.Book(dlg.FileName)
    Dim Sheet As XLS.Sheet = Book.Sheets(0)
    For n As Integer = 1 To Sheet.Rows.Count -1
        Dim r As DataRow = t.DataTable.Find("部门受案号 = \'" & sheet(n,0).text & "\'")
        If r Is Nothing Then r = t.DataTable.AddNew()
        For i As Integer = 0 To sheet.Cols.Count -1
            Dim cname As String = sheet(0, i).text
            If t.Cols.Contains(cname) Then
                r(cname) = sheet(n, i).Text
            End If
        Next
    Next
    t.ResumeRedraw()
End If

--  作者:李孝春
--  发布时间:2019/2/15 11:39:00
--  回复:(有点甜)Dim dlg As New OpenFileDialogdlg.F...
有点甜老师  上述方法在导入表和拟写入表中的列名一样的话  已经实现完美导入

但是假设导入表中有一个  移诉意见        案件基本信息表中   对应的  移送意见    怎么匹配呢?列名位置不一定是一一对应的   也存在跨行的情况

--  作者:有点甜
--  发布时间:2019/2/15 11:53:00
--  

Dim dlg As New OpenFileDialog
dlg.Filter = "Excel文件|*.xls;*.xlsx"
If dlg.ShowDialog =DialogResult.OK Then
    Dim t As Table = Tables("案件基本信息")
    t.StopRedraw()
    Dim Book As New XLS.Book(dlg.FileName)
    Dim Sheet As XLS.Sheet = Book.Sheets(0)
    For n As Integer = 1 To Sheet.Rows.Count -1
        Dim r As DataRow = t.DataTable.Find("部门受案号 = \'" & sheet(n,0).text & "\'")
        If r Is Nothing Then r = t.DataTable.AddNew()
        For i As Integer = 0 To sheet.Cols.Count -1
            Dim cname As String = sheet(0, i).text
            If t.Cols.Contains(cname) Then
                r(cname) = sheet(n, i).Text

            ElseIf cname = "移诉意见" Then

                r("移送意见") = sheet(n, i).Text
            End If
        Next
    Next
    t.ResumeRedraw()
End If


--  作者:李孝春
--  发布时间:2019/2/16 1:30:00
--  回复:(有点甜)Dim dlg As New OpenFileDialogdlg.F...
有点甜老师  晚上好
经过测试   该代码是每次都导入数据  并且更新所有列

有没有办法加入一个判断
导入前先判断案件基本信息表中有没有部门受案号存在
如果有   那么该部门受案号不再新增  只是更新所有列值
如果没有  那么该部门受案号新增并且更新所有列值

其中案件基本信息表中 是否关联   这个列值不能因为导入数据而更新的  要确保其永远不变      



--  作者:有点蓝
--  发布时间:2019/2/16 9:05:00
--  
Dim dlg As New OpenFileDialog
dlg.Filter = "Excel文件|*.xls;*.xlsx"
If dlg.ShowDialog =DialogResult.OK Then
    Dim t As Table = Tables("案件基本信息")
    t.StopRedraw()
    Dim Book As New XLS.Book(dlg.FileName)
    Dim Sheet As XLS.Sheet = Book.Sheets(0)
    For n As Integer = 1 To Sheet.Rows.Count -1
        Dim r As DataRow = t.DataTable.Find("部门受案号 = \'" & sheet(n,0).text & "\'")
        Dim Isnew As Boolean
        If r Is Nothing Then
            r = t.DataTable.AddNew()
            Isnew  = True
        End If
        For i As Integer = 0 To sheet.Cols.Count -1
            Dim cname As String = sheet(0, i).text
            If t.Cols.Contains(cname) Then
                If Isnew = False AndAlso cname = "是否关联" Then Continue For
                r(cname) = sheet(n, i).Text
            ElseIf cname = "移诉意见" Then
                r("移送意见") = sheet(n, i).Text
            End If
        Next
    Next
    t.ResumeRedraw()
End If

--  作者:李孝春
--  发布时间:2019/2/16 10:10:00
--  回复:(有点蓝)Dim dlg As New OpenFileDialogdlg.F...
有点蓝老师     现在数据还是会新增

是想实现在数据导入之前,将导入前的部门受案号去对比案件基本信息表中的部门受案号

如果有部门受案号存在  就不新增数据行,只是更新表中的列值与案件基本信息表中的列值
如果没有部门受案号存在  就新增数据行   更新表中的全部列值到案件基本信息表中

--  作者:有点蓝
--  发布时间:2019/2/16 10:31:00
--  
本来就是这样处理的,请看懂代码,并仔细测试。

另外检查execl或者Foxtable的部门受案号是否有多余的空格或者其它看不见的符号,导致查询不到

Dim r As DataRow = t.DataTable.Find("部门受案号 = \'" & sheet(n,0).text.trim() & "\'")