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

dr = DataTables("流转记录表").Find("样品编号 = '" & Ary(0) & "' and 流转项目 = '" & Values(i) & "' and 检测项目 = '" & Ary1(0) & "' and 检测依据 = '" & Ary1(1) & "' and 检测部门 = '" & Ary1(2) & "' and 检测费用 = '" & Ary1(3) & "' and 费用说明 = '" & Ary1(4) & "'")

这条代码就是用来对比拆分的数据是吗？如果列出来的这些都相同才不会继续重复添加？

理解正确，不过，后面列没必要比较了。因为，前两列就可以确定后面的不同。

以下是引用lin_hailun在2012-9-13 17:13:00的发言：
第二个问题，参考

http://www.foxtable.com/help/topics/1665.htm

对于选定区域执行下面代码还不是很懂，麻烦高手帮忙看下要怎么改~谢谢啦！

Tables("检测流程流转记录表").StopRedraw

Dim Arys As List(Of String())

Arys = DataTables("样品信息").GetUniqueValues("样品编号 is not null","样品编号","检测项目")

For Each Ary As String() In Arys

Dim s As String = Ary(1)

Dim Values() As String = s.Split(",")

For i As Integer = 0 To Values.Length - 1

Dim Arys1 As List(Of String())

Arys1 = DataTables("检测项目").GetUniqueValues("加载流转项目 = '" & Values(i) & "'", "检测项目","检测依据","检测部门","报价费用","费用说明")

For Each Ary1 As String() In Arys1

Dim dr As DataRow

dr = DataTables("检测流程流转记录表").Find("样品编号 = '" & Ary(0) & "' and 加载流转项目 = '" & Values(i) & "'")

If dr Is Nothing Then

Dim r As Row = Tables("检测流程流转记录表").AddNew()

r("样品编号") = Ary(0)

r("加载流转项目") = Values(i)

r("检测项目") = Ary1(0)

r("检测依据") = Ary1(1)

r("检测部门") = Ary1(2)

r("报价费用") = Ary1(3)

r("费用说明") = Ary1(4)

End If

Tables("检测流程流转记录表").ResumeRedraw

以下是引用lxhmax在2012-9-23 19:44:00的发言：

对于选定区域执行下面代码还不是很懂，麻烦高手帮忙看下要怎么改~谢谢啦！

Tables("检测流程流转记录表").StopRedraw

Dim Arys As List(Of String())

Arys = DataTables("样品信息").GetUniqueValues("样品编号 is not null","样品编号","检测项目")

For Each Ary As String() In Arys

Dim s As String = Ary(1)

Dim Values() As String = s.Split(",")

For i As Integer = 0 To Values.Length - 1

Dim Arys1 As List(Of String())

Arys1 = DataTables("检测项目").GetUniqueValues("加载流转项目 = '" & Values(i) & "'", "检测项目","检测依据","检测部门","报价费用","费用说明")

For Each Ary1 As String() In Arys1

Dim dr As DataRow

dr = DataTables("检测流程流转记录表").Find("样品编号 = '" & Ary(0) & "' and 加载流转项目 = '" & Values(i) & "'")

If dr Is Nothing Then

Dim r As Row = Tables("检测流程流转记录表").AddNew()

r("样品编号") = Ary(0)

r("加载流转项目") = Values(i)

r("检测项目") = Ary1(0)

r("检测依据") = Ary1(1)

r("检测部门") = Ary1(2)

r("报价费用") = Ary1(3)

r("费用说明") = Ary1(4)

End If

Tables("检测流程流转记录表").ResumeRedraw

这个问题麻烦各位再帮我看看~谢谢啦~

楼主，这样写代码，如下：

Dim nums As String
For i As Integer = Tables("表A").TopRow To Tables("表A").BottomRow
    nums = nums & Tables("表A").Rows(i)("委托编号") & ","
Next

nums = nums.Trim(",")

Tables("表C").StopRedraw
Dim Arys As List(Of String())
Arys = DataTables("表A").GetUniqueValues("委托编号 in (" & nums & ")", "委托编号","委托项目")
For Each Ary As String() In Arys
    Dim s As String = Ary(1)
    Dim Values() As String = s.split(",")
    For i As Integer = 0 To Values.Length - 1
        Dim Arys1 As List(Of String())
        Arys1 = DataTables("表D").GetUniqueValues("委托项目 = '" & Values(i) & "'", "项目依据","项目明细","明细依据","项目单位")
        For Each Ary1 As String() In Arys1
            Dim dr As DataRow
            dr = DataTables("表C").Find("委托编号 = '" & Ary(0) & "' and 委托项目 = '" & Values(i) & "' and 项目依据 = '" & Ary1(0) & "' and 项目明细 = '" & Ary1(1) & "' and 明细依据 = '" & Ary1(2) & "' and 项目单位 = '" & Ary1(3) & "'")
            If dr Is Nothing Then
                Dim r As Row = Tables("表C").AddNew()
                r("委托编号") = Ary(0)
                r("委托项目") = Values(i)
                r("项目依据") = Ary1(0)
                r("项目明细") = Ary1(1)
                r("明细依据") = Ary1(2)
                r("项目单位") = Ary1(3)
            End If
        Next
    Next
Next
Tables("表C").ResumeRedraw

非常感谢你给我这么多的帮助~

主题：[求助]项目数据批量拆分