Foxtable(狐表)用户栏目专家坐堂 → 请教复杂的excel数据导入


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

主题:请教复杂的excel数据导入

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


加好友 发短信
等级:幼狐 帖子:149 积分:1289 威望:0 精华:0 注册:2018/12/12 23:23:00
请教复杂的excel数据导入  发帖心情 Post By:2019/12/23 12:50:00 [只看该作者]

如图:

图片点击可在新窗口打开查看此主题相关图片如下:tim图片20191223124745.png
图片点击可在新窗口打开查看
这个表格的格式是固定的,只提取红色圈内的数据到FT
请老师教一下

 回到顶部
帅哥,在线噢!
有点蓝
  2楼 | 信息 | 搜索 | 邮箱 | 主页 | UC


加好友 发短信
等级:超级版主 帖子:106688 积分:542629 威望:0 精华:9 注册:2015/6/24 9:21:00
  发帖心情 Post By:2019/12/23 13:34:00 [只看该作者]


 回到顶部
帅哥哟,离线,有人找我吗?
禾成
  3楼 | 信息 | 搜索 | 邮箱 | 主页 | UC


加好友 发短信
等级:幼狐 帖子:149 积分:1289 威望:0 精华:0 注册:2018/12/12 23:23:00
提取不到数据帮我看看  发帖心情 Post By:2019/12/23 17:15:00 [只看该作者]

For Each file As String In filesys .GetFiles("c:\Data")
    If 
file.EndsWith(".xls") OrElse file.EndsWith(".xlsx") Then
        Dim 
Book As New XLS.Book(file)
        Dim 
Sheet As XLS.Sheet = Book.Sheets(0)
        Dim 
dr As DataRow = DataTables("员工").AddNew
        
dr("姓名") = sheet(4,1).Text
        
dr("部门") = sheet(5,1).text
        
dr("出生日期") = sheet(4,3).text
        
dr("雇佣日期") = sheet(5,3).text
        
dr("性别") = sheet(6,1).text
        
dr("职务") = sheet(6,3).text
        
dr("地址") = sheet(7,1).text
        
dr("家庭电话") = sheet(8,1).text
        
dr("办公电话") = sheet(8,3).text
        
dr("备注") = sheet(9,0).text
    End If
Next

按照这个代码来却提取不到数据,下面实例
 下载信息  [文件大小:   下载次数: ]
图片点击可在新窗口打开查看点击浏览该文件:管理项目1.rar


 回到顶部
帅哥,在线噢!
有点蓝
  4楼 | 信息 | 搜索 | 邮箱 | 主页 | UC


加好友 发短信
等级:超级版主 帖子:106688 积分:542629 威望:0 精华:9 注册:2015/6/24 9:21:00
  发帖心情 Post By:2019/12/23 17:19:00 [只看该作者]

索引从0开始的,

dr("程序路径") = sheet1(1,2).value '第2行,第3列

 回到顶部
帅哥哟,离线,有人找我吗?
禾成
  5楼 | 信息 | 搜索 | 邮箱 | 主页 | UC


加好友 发短信
等级:幼狐 帖子:149 积分:1289 威望:0 精华:0 注册:2018/12/12 23:23:00
合并数据很多空行  发帖心情 Post By:2019/12/23 22:09:00 [只看该作者]

Dim dlg As New OpenFileDialog
dlg.Filter= "所有文件|*.*|Excel2003文件|*.xls|Excel2007文件|*.xlsx" '设置筛选器
If dlg.ShowDialog = DialogResult.Ok Then '如果用户单击了确定按钮
    MessageBox.Show("你选择的是:" & dlg.FileName,"提示")
    If MessageBox.Show("是否合并?","请确 认!",MessageBoxButtons.OKCancel,MessageBoxIcon.Question) = DialogResult.OK Then
        Dim Book As New XLS.Book(dlg.FileName)
        Dim Sheet_qj As XLS.Sheet = Book.Sheets(0)
        Dim dr As DataRow = DataTables("钢料程序单").AddNew
        dr("程序路径") = sheet_qj(1,2).value
        dr("制表日期") = sheet_qj(1,9).value
        dr("工件编号") = sheet_qj(2,2).value
        dr("客户") = sheet_qj(2,5).value
        dr("编程") = sheet_qj(2,9).value
        dr("分中方式") = sheet_qj(3,2).value
        dr("工件尺寸") = sheet_qj(3,5).value
        dr("预计时间") = sheet_qj(9,10).value
        dr("x") = sheet_qj(9,2).value
        dr("y") = sheet_qj(5,0).value
        dr("正x") = sheet_qj(11,3).value
        dr("正y") = sheet_qj(11,5).value
        dr("正z") = sheet_qj(11,9).value
        dr("负x") = sheet_qj(12,3).value
        dr("负y") = sheet_qj(12,5).value
        dr("负z") = sheet_qj(12,9).value
        
        
        
        Dim Sheet As XLS.Sheet = Book.Sheets(0)
        Tables("钢料程序单.钢料程序明细").StopRedraw()
        '注意以下数组中列名称的顺序,必须和Excel表中的列顺序一致
        Dim nms() As String = {"序号","NC名称","程序说明","刀头","刀具","刀长","刃长","xyz余量","z深度","加工时间","备注"}
        '注意下面的循环变量从1开始,而不是从0开始,因为Excel表的第一行是标题
        For n As Integer = 14 To Sheet.Rows.Count -12
                        Dim r As Row = Tables("钢料程序单.钢料程序明细").AddNew
            For m As Integer = 0 To nms.Length - 1
                r(nms(m)) = Sheet(n,m).Value
            Next
        Next
    End If
End If
MessageBox.Show("导入成功!","恭喜!")
Tables("钢料程序单.钢料程序明细").ResumeRedraw()

 回到顶部
帅哥,在线噢!
有点蓝
  6楼 | 信息 | 搜索 | 邮箱 | 主页 | UC


加好友 发短信
等级:超级版主 帖子:106688 积分:542629 威望:0 精华:9 注册:2015/6/24 9:21:00
  发帖心情 Post By:2019/12/23 22:27:00 [只看该作者]

For n As Integer = 14 To Sheet.Rows.Count -12
if Sheet(n,1).Value = "" then continue for
                        Dim r As Row = Tables("钢料程序单.钢料程序明细").AddNew
            For m As Integer = 0 To nms.Length - 1
                r(nms(m)) = Sheet(n,m).Value
            Next
        Next

 回到顶部
帅哥哟,离线,有人找我吗?
禾成
  7楼 | 信息 | 搜索 | 邮箱 | 主页 | UC


加好友 发短信
等级:幼狐 帖子:149 积分:1289 威望:0 精华:0 注册:2018/12/12 23:23:00
感谢有点蓝老师!excel导入解决  发帖心情 Post By:2019/12/24 9:01:00 [只看该作者]

入手高开已有大半年,一路走来坎坷不断,在老师的帮助下也弄出了个方便自己工作的小程序,很开心!谢谢!

 回到顶部
帅哥,在线噢!
有点蓝
  8楼 | 信息 | 搜索 | 邮箱 | 主页 | UC


加好友 发短信
等级:超级版主 帖子:106688 积分:542629 威望:0 精华:9 注册:2015/6/24 9:21:00
  发帖心情 Post By:2019/12/24 9:08:00 [只看该作者]

这也正是我们所期望的,一起加油!

 回到顶部