Foxtable(狐表) → 用户栏目 → 专家坐堂 → 自选excel位置添加导入数据


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

主题：自选excel位置添加导入数据
帅哥哟，离线，有人找我吗？
有点蓝
 小大  1楼 | 信息 | 搜索 | 邮箱 | 主页 | UC


加好友 发短信
等级：超级版主 帖子：109200 积分：555620 威望：0 精华：9 注册：2015/6/24 9:21:00 		  发帖心情 Post By：2024/3/12 17:20:00 [显示全部帖子]

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 = {"棋赛名称", "棋赛副名", "编号", "姓名", "身份"}
 回到顶部
帅哥哟，离线，有人找我吗？
有点蓝
 小大  2楼 | 信息 | 搜索 | 邮箱 | 主页 | UC


加好友 发短信
等级：超级版主 帖子：109200 积分：555620 威望：0 精华：9 注册：2015/6/24 9:21:00 		  发帖心情 Post By：2024/3/12 17:24:00 [显示全部帖子]

怎么知道要用第几个呢？靠猜的么

 回到顶部
帅哥哟，离线，有人找我吗？
有点蓝
 小大  3楼 | 信息 | 搜索 | 邮箱 | 主页 | UC


加好友 发短信
等级：超级版主 帖子：109200 积分：555620 威望：0 精华：9 注册：2015/6/24 9:21:00 		  发帖心情 Post By：2024/3/14 8:39:00 [显示全部帖子]

        For m As Integer = 0 To nms.Length - 1
if Sheet(n, m).text > ""
            dr(nms(m)) = Sheet(n, m).Value
else
dr(nms(m)) = nothing
end if
        Next
 回到顶部
帅哥哟，离线，有人找我吗？
有点蓝
 小大  4楼 | 信息 | 搜索 | 邮箱 | 主页 | UC


加好友 发短信
等级：超级版主 帖子：109200 积分：555620 威望：0 精华：9 注册：2015/6/24 9:21:00 		  发帖心情 Post By：2024/3/14 10:58:00 [显示全部帖子]

可能是下面的问题，编号是整数列？execl路是不是有编号为空的行？


        Dim bh1 As String = sheet(n, i1).Text
        Dim bh2 As Integer = sheet(n, i2).Value
        Dim bh3 As String = sheet(n, i3).Text
        Dim dr As DataRow = DataTables("基本信息").SQLFind("[棋赛名称] = '" & bh1 & "' And [编号] =" & bh2 & " And [姓名] = '" & bh3 & "'")
 回到顶部
帅哥哟，离线，有人找我吗？
有点蓝
 小大  5楼 | 信息 | 搜索 | 邮箱 | 主页 | UC


加好友 发短信
等级：超级版主 帖子：109200 积分：555620 威望：0 精华：9 注册：2015/6/24 9:21:00 		  发帖心情 Post By：2024/3/14 11:21:00 [显示全部帖子]

 Dim bh1 As String = sheet(n, i1).Text
        Dim bh2 As Integer = val(sheet(n, i2).Value)
        Dim bh3 As String = sheet(n, i3).Text
        Dim dr As DataRow
if bh2=0
 dr=DataTables("基本信息").SQLFind("[棋赛名称] = '" & bh1 & "' And [编号] is null And [姓名] = '" & bh3 & "'")
else
dr=DataTables("基本信息").SQLFind("[棋赛名称] = '" & bh1 & "' And [编号] =" & bh2 & " And [姓名] = '" & bh3 & "'")
end if
 回到顶部
帅哥哟，离线，有人找我吗？
有点蓝
 小大  6楼 | 信息 | 搜索 | 邮箱 | 主页 | UC


加好友 发短信
等级：超级版主 帖子：109200 积分：555620 威望：0 精华：9 注册：2015/6/24 9:21:00 		  发帖心情 Post By：2024/3/14 15:07:00 [显示全部帖子]

参考这种，使用字典记录列名之间的关系：http://www.foxtable.com/bbs/dispbbs.asp?BoardID=2&ID=102185

 回到顶部
帅哥哟，离线，有人找我吗？
有点蓝
 小大  7楼 | 信息 | 搜索 | 邮箱 | 主页 | UC


加好友 发短信
等级：超级版主 帖子：109200 积分：555620 威望：0 精华：9 注册：2015/6/24 9:21:00 		  发帖心情 Post By：2024/3/14 23:22:00 [显示全部帖子]

Dim dlg As New OpenFileDialog '定义一个新的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 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 Tables("基本信息").Cols.Contains(ary(1, c)) Then
                dict2.add(ary(1, c), c)
            End If
        Next
        Dim dr As DataRow
        For n As Integer = 2 To rg.Rows.count
            Dim bh1 As String = ary(n, dict2("棋赛名称"))
            Dim bh2 As String = ary(n, dict2("棋赛副名"))
            Dim bh3 As String = ary(n, dict2("编称"))
            Dim bh4 As String = ary(n, dict2("姓名"))
            If bh2 = "0" OrElse bh2 = "" Then
                If bh3 = "0" OrElse bh3 = "" Then
                    dr = DataTables("基本信息").SQLFind("[棋赛名称] = '" & bh1 & "' And [棋赛副名] is null And [编号] is null And [姓名] = '" & bh4 & "' And [身份] <> '参赛人'")
                Else
                    dr = DataTables("基本信息").SQLFind("[棋赛名称] = '" & bh1 & "' And [棋赛副名] is null And [编号] = '" & bh3 & "' And [姓名] = '" & bh4 & "' And [身份] = '参赛人'")
                End If
            Else
                If bh3 = "0" OrElse bh3 = "" Then
                    dr = DataTables("基本信息").SQLFind("[棋赛名称] = '" & bh1 & "' And [棋赛副名] = '" & bh2 & "' And [编号] Is null And [姓名] = '" & bh4 & "' And [身份] <> '参赛人'")
                Else
                    dr = DataTables("基本信息").SQLFind("[棋赛名称] = '" & bh1 & "' And [棋赛副名] = '" & bh2 & "' And [编号] =" & bh3 & " And [姓名] = '" & bh4 & "' And [身份] = '参赛人'")
                End If
            End If
            If dr Is Nothing Then '如果基本信息表不存在同一棋赛名称、编号、姓名的行
                dr = DataTables("基本信息").AddNew()
            End If
            For Each key As String In dict2.Keys
                dr(key) = ary(n, dict2(key))
            Next
        Next
        Tables("基本信息").ResumeRedraw()
    Catch ex As exception
        app.quit
        Tables("基本信息").ResumeRedraw()
    End Try
End If
 回到顶部
帅哥哟，离线，有人找我吗？
有点蓝
 小大  8楼 | 信息 | 搜索 | 邮箱 | 主页 | UC


加好友 发短信
等级：超级版主 帖子：109200 积分：555620 威望：0 精华：9 注册：2015/6/24 9:21:00 		  发帖心情 Post By：2024/3/15 8:57:00 [显示全部帖子]

Dim dlg As New OpenFileDialog '定义一个新的OpenFileDialog
dlg.Filter = "excel文件|*.xls;*.xlsx" '设置筛选器
If dlg.ShowDialog = DialogResult.Ok Then '如果用户单击了确定按钮
    Try
        Dim Book As New XLS.Book(dlg.FileName)
        Dim Sheet As XLS.Sheet = Book.Sheets(0)
        Tables("基本信息").StopRedraw()
        Dim dict2 As New Dictionary(Of String, Integer)
        For c As Integer = 0 To Sheet.Cols.Count - 1
            If Tables("基本信息").Cols.Contains(Sheet(1, c).Value) Then
                dict2.add(Sheet(1, c).Value, c)
            End If
        Next
        Dim dr As DataRow
        For n As Integer = 1 To Sheet.Rows.Count - 1
            Dim bh1 As String = Sheet(n, dict2("棋赛名称")).Value
            Dim bh2 As String = Sheet(n, dict2("棋赛副名")).Value
            Dim bh3 As String = Sheet(n, dict2("编称")).Value
            Dim bh4 As String = Sheet(n, dict2("姓名")).Value
            If bh2 = "0" OrElse bh2 = "" Then
                If bh3 = "0" OrElse bh3 = "" Then
                    dr = DataTables("基本信息").SQLFind("[棋赛名称] = '" & bh1 & "' And [棋赛副名] is null And [编号] is null And [姓名] = '" & bh4 & "' And [身份] <> '参赛人'")
                Else
                    dr = DataTables("基本信息").SQLFind("[棋赛名称] = '" & bh1 & "' And [棋赛副名] is null And [编号] = '" & bh3 & "' And [姓名] = '" & bh4 & "' And [身份] = '参赛人'")
                End If
            Else
                If bh3 = "0" OrElse bh3 = "" Then
                    dr = DataTables("基本信息").SQLFind("[棋赛名称] = '" & bh1 & "' And [棋赛副名] = '" & bh2 & "' And [编号] Is null And [姓名] = '" & bh4 & "' And [身份] <> '参赛人'")
                Else
                    dr = DataTables("基本信息").SQLFind("[棋赛名称] = '" & bh1 & "' And [棋赛副名] = '" & bh2 & "' And [编号] =" & bh3 & " And [姓名] = '" & bh4 & "' And [身份] = '参赛人'")
                End If
            End If
            If dr Is Nothing Then '如果基本信息表不存在同一棋赛名称、编号、姓名的行
                dr = DataTables("基本信息").AddNew()
            End If
            For Each key As String In dict2.Keys
                dr(key) = Sheet(n, dict2(key)).Value
            Next
        Next
        Tables("基本信息").ResumeRedraw()
    Catch ex As exception
        Tables("基本信息").ResumeRedraw()
    End Try
End If
 回到顶部
帅哥哟，离线，有人找我吗？
有点蓝
 小大  9楼 | 信息 | 搜索 | 邮箱 | 主页 | UC


加好友 发短信
等级：超级版主 帖子：109200 积分：555620 威望：0 精华：9 注册：2015/6/24 9:21:00 		  发帖心情 Post By：2024/3/15 10:23:00 [显示全部帖子]

请上传实例说明

 回到顶部
帅哥哟，离线，有人找我吗？
有点蓝
 小大  10楼 | 信息 | 搜索 | 邮箱 | 主页 | UC


加好友 发短信
等级：超级版主 帖子：109200 积分：555620 威望：0 精华：9 注册：2015/6/24 9:21:00 		  发帖心情 Post By：2024/3/15 11:52:00 [显示全部帖子]


Dim dlg As New OpenFileDialog '定义一个新的OpenFileDialog
dlg.Filter = "excel文件|*.xls;*.xlsx" '设置筛选器
If dlg.ShowDialog = DialogResult.Ok Then '如果用户单击了确定按钮
    Try
        Dim Book As New XLS.Book(dlg.FileName)
        Dim Sheet As XLS.Sheet = Book.Sheets(0)
        Tables("基本信息").StopRedraw()
        Dim dict2 As New Dictionary(Of String, Integer)
        For c As Integer = 0 To Sheet.Cols.Count - 1
            If Tables("基本信息").Cols.Contains(Sheet(0, c).Value) Then
                dict2.add(Sheet(0, c).Value, c)
            End If
        Next
        Dim dr As DataRow
        For n As Integer = 1 To Sheet.Rows.Count - 1
            Dim bh1 As String = Sheet(n, dict2("棋赛名称")).Value
            If bh1 = "" Then Exit For
            Dim bh2 As String = Sheet(n, dict2("棋赛副名")).Value
            Dim bh3 As String = Sheet(n, dict2("编号")).Value
            Dim bh4 As String = Sheet(n, dict2("姓名")).Value
            Dim filter As String
            If bh2 = "0" OrElse bh2 = "" Then
                If bh3 = "0" OrElse bh3 = "" Then
                    filter = "[棋赛名称] = '" & bh1 & "' And [棋赛副名] is null And [编号] is null And [姓名] = '" & bh4 & "' And [身份] <> '参赛人'"
                Else
                    filter = "[棋赛名称] = '" & bh1 & "' And [棋赛副名] is null And [编号] = '" & bh3 & "' And [姓名] = '" & bh4 & "' And [身份] = '参赛人'"
                End If
            Else
                If bh3 = "0" OrElse bh3 = "" Then
                    filter = "[棋赛名称] = '" & bh1 & "' And [棋赛副名] = '" & bh2 & "' And [编号] Is null And [姓名] = '" & bh4 & "' And [身份] <> '参赛人'"
                Else
                    filter = "[棋赛名称] = '" & bh1 & "' And [棋赛副名] = '" & bh2 & "' And [编号] =" & bh3 & " And [姓名] = '" & bh4 & "' And [身份] = '参赛人'"
                End If
            End If
            dr = DataTables("基本信息").SQLFind(filter)
            If dr Is Nothing Then '如果基本信息表不存在同一棋赛名称、编号、姓名的行
                dr = DataTables("基本信息").AddNew()
            End If
            For Each key As String In dict2.Keys
                If Sheet(n, dict2(key)).text > "" Then
                    dr(key) = Sheet(n, dict2(key)).Value
                Else
                    dr(key) = Nothing
                End If
            Next
        Next
        Tables("基本信息").ResumeRedraw()
    Catch ex As exception
        MsgBox(ex.Message)
        Tables("基本信息").ResumeRedraw()
    End Try
End If
 回到顶部
总数 14 1 2 下一页
RSS2.0 | Xhtml无图版 | Xslt无图版 Copyright © 2000 - 2018 foxtable.com Tel: 4000-810-820 粤ICP备11091905号
   Powered By Dvbbs Version 8.3.0
页面执行时间 0.05664 秒, 5 次数据查询