专家坐堂-[求助]多张excel合并成一张Foxtable(狐表) - 新一代数据库软件，完美融合Access、Foxpro、Excel、vb.net之优势，人人都能掌握的快速软件开发工具!

以文本方式查看主题

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

--  作者：ming8604
--  发布时间：2016/10/6 0:03:00
--  [求助]多张excel合并成一张
现在一题作业题。多张excel表合并成一张，表格如下：

姓名

选课

成绩

学分

备注

陈大

语文

65

2

　

刘二

数学

66

2

　

张三

英语

58

2

　

王五

化学

77

2

　

杨六

语文

64

2

　

黄七

数学

57

2

　

周八

英语

77

2

　

赵九

物理

55

1

不及格

姓名

选课

成绩

学分

备注

陈大

数学

73

2

　

刘二

物理

69

2

　

张三

英语

65

2

重修

李四

数学

45

1

不及格　

王五

英语

77

2

　

杨六

语文

64

2

　

黄七

数学

63

2

重修

合并要求：如果下一张表中，出现同名同选课，以新表数据成绩学分等为准（即覆盖原表中的一列）。

新手无从下手，请老师指点一二。谢谢

[此贴子已经被作者于2016/10/6 0:04:48编辑过]

--  作者：新福星
--  发布时间：2016/10/6 7:26:00
--
1 在Excel文件中按先名顺序把所有Sheet合并到一起，并标序顺号；
2 全部加载到FoxTable 一个表中，名为表A；
3 在FoxTable再建一个表名为表B，格式和表A相同；
4 在杂项命令窗口编一段如下程序，执行即可
Dim s As Row
For Each a As Row In Tables("表A").Rows
r=DataTables("表B").find("姓名=\'" & a("姓名") & "\' And 选课=\'" & a("选课") & "\'")
If r Is Nothing Then
s=Tables("表B").AddNew
s("姓名")=a("姓名")
s("选课")=a("选课")
s("成绩")=a("成绩")
s("学分")=a("学分")
s("备注")=a("备注")
Else

r("成绩")=a("成绩")
r("学分")=a("学分")
r("备注")=a("备注")

End If

Next

不知还有什么更简单的方法了

--  作者：有点蓝
--  发布时间：2016/10/6 9:34:00
--
参考：http://www.foxtable.com/webhelp/scr/2334.htm

Dim dlg As New OpenFileDialog
dlg.MultiSelect = True
If dlg.ShowDialog = DialogResult.OK Then
Tables("订单").StopRedraw()
For Each fn As String In dlg.FileNames
Dim Book As New XLS.Book(fn)
Dim Sheet As XLS.Sheet = Book.Sheets(0)
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
Next
Tables("订单").ResumeRedraw()
End If

--  作者：大雪山
--  发布时间：2016/10/6 11:16:00
--

有点蓝老师:

这个公式是按编号添加的,Excel表头

编号产品客户雇员单价数量折扣日期

这部分没有对应上,这公式麻烦老师能再修改下

--  作者：有点蓝
--  发布时间：2016/10/6 11:48:00
--
4楼，没看懂你的意思

--  作者：大雪山
--  发布时间：2016/10/6 12:02:00
--
Excel表头改成能按编号产品两个字段相同的添加,也就是向库中同编号产品增填加数据.

--  作者：有点蓝
--  发布时间：2016/10/6 12:07:00
--
......
For n As Integer = 1 To Sheet.Rows.Count -1
Dim bh As String = sheet(n,0).Text
Dim cp As String = sheet(n,1).Text
Dim dr As DataRow = DataTables("订单").Find("编号 = \'" & bh & "\' and 产品=\'" & cp & "\'")
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
......

--  作者：ming8604
--  发布时间：2016/10/6 12:48:00
--

按照你所述，在命令窗口输入：
Dim s As Row
For Each a As Row In Tables("原表").Rows
r=DataTables("新表").find("姓名=\'" & a("姓名") & "\' And 选课=\'" & a("选课") & "\'")
If r Is Nothing Then
s=Tables("新表").AddNew
s("姓名")=a("姓名")
s("选课")=a("选课")
s("成绩")=a("成绩")
s("学分")=a("学分")
s("备注")=a("备注")
Else

r("成绩")=a("成绩")
r("学分")=a("学分")
r("备注")=a("备注")

End If

Next

执行的时候报错了。
编译错误：“r”是private，因此他在此文上下文中不可访问。
错误代码： r=DataTables("新表").find("姓名=\'" & a("姓名") & "\' And 选课=\'" & a("选课") & "\'")

这个是什么问题？？我重启过两次了，依然这个报错。

--  作者：ming8604
--  发布时间：2016/10/6 13:28:00
--
老师，我只是想学好表单统计，就foxtable当成软件来操作了。

一点开就开发板块，感觉一下子要学的好多了。

--  作者：有点蓝
--  发布时间：2016/10/6 14:20:00
--
1楼这种情况只能用代码处理。如果没有代码基础，只能是自己在Execl合并数据并过滤重复数据后再导入狐表。