Foxtable(狐表)用户栏目专家坐堂 → 求助:自动进行记录列值调整


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

主题:求助:自动进行记录列值调整

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


加好友 发短信
等级:版主 帖子:85326 积分:427815 威望:0 精华:5 注册:2012/10/18 22:13:00
  发帖心情 Post By:2017/12/11 18:45:00 [显示全部帖子]

汗,递归就不写了麻烦,直接判断。

 

下面代码只做了两种情况的判断,你扩展一下写。

 

Dim dt1 As DataTable = DataTables("希望调整后统计结果")
Dim dt2 As DataTable = DataTables("原始数据")
Dim dtb As new DataTableBuilder("测试")
dtb.AddDef("编号", Gettype(String), 32)
dtb.AddDef("数据一", Gettype(String), 32)
dtb.AddDef("数据二", Gettype(String), 32)
dtb.AddDef("数据三", Gettype(String),32)
dtb.Build()
Dim dt3 As DataTable = DataTables("测试")
dt3.AddNew(dt2.DataRows.count)
Dim ary() As String = {"数据一", "数据二", "数据三"}
Dim drs = dt1.Select("科目 <> '总计'")
For Each c As String In ary
    Dim idx As Integer = 0
    For Each dr As DataRow In drs
        For i As Integer = idx To idx+dr(c)-1
            dt3.DataRows(i)(c) = dr("科目")
        Next
        idx += dr(c)
    Next
Next
For i As Integer = 0 To 10 '测试少量数据
    Dim dr As DataRow = dt2.DataRows(i)
   
    'Dim ls As new List(Of String)
    'ls.add(dr("数据一"))
    'ls.add(dr("数据二"))
    'ls.add(dr("数据三"))
   
    'Dim flag As Boolean = False
    'For Each cdr As DataRow In dt3.DataRows
    'If cdr.Isnull("编号") Then
    'If ls.Contains(cdr("数据一")) AndAlso ls.Contains(cdr("数据二")) AndAlso ls.Contains(cdr("数据三")) AndAlso cdr("数据一") <> cdr("数据二") AndAlso cdr("数据一") <> cdr("数据三") AndAlso cdr("数据三") <> cdr("数据二")Then
    'flag = True
    'cdr("编号") = dr("编号")
    'Exit For
    'End If
    'End If
    'Next
   
   
    Dim temp As String = ""
    For Each cdr As DataRow In dt3.DataRows
        If cdr.Isnull("编号") Then
            If dr("数据一") = cdr("数据一") OrElse dr("数据一") = cdr("数据二") OrElse dr("数据一") = cdr("数据三") Then
                If dr("数据一") = cdr("数据一") Then
                    For Each ccdr As DataRow In dt3.DataRows
                        If ccdr.Isnull("编号") Then
                            If dr("数据二") = ccdr("数据二") OrElse dr("数据二") = ccdr("数据三") Then
                                If dr("数据二") = ccdr("数据二") Then
                                    For Each cccdr As DataRow In dt3.DataRows
                                        If cccdr.Isnull("编号") Then
                                            If dr("数据三") = cccdr("数据三") Then
                                                cdr("编号") = dr("编号")
                                                temp = cdr("数据三")
                                                cdr("数据三") = cccdr("数据三")
                                                cccdr("数据三") = temp
                                                temp = cdr("数据二")
                                                cdr("数据二") = ccdr("数据二")
                                                ccdr("数据二") = temp

                                                Exit For
                                            End If
                                        End If
                                    Next
                                ElseIf dr("数据二") = ccdr("数据三") Then
                                    For Each cccdr As DataRow In dt3.DataRows
                                        If cccdr.Isnull("编号") Then
                                            If dr("数据三") = cccdr("数据二") Then
                                                cdr("编号") = dr("编号")
                                                temp = cdr("数据二")
                                                cdr("数据二") = cccdr("数据二")
                                                cccdr("数据二") = temp
                                                temp = cdr("数据三")
                                                cdr("数据三") = ccdr("数据三")
                                                ccdr("数据三") = temp

                                                Exit For
                                            End If
                                        End If
                                    Next

                                End If
                                Exit For
                            End If
                        End If
                    Next
                End If
                Exit For
            End If
        End If
    Next
Next
MainTable = Tables("测试")

 


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


加好友 发短信
等级:版主 帖子:85326 积分:427815 威望:0 精华:5 注册:2012/10/18 22:13:00
  发帖心情 Post By:2017/12/17 21:07:00 [显示全部帖子]

1、看懂2楼代码;

 

2、判断各个组合集合,2楼的代码判断的是  数据一=数据一,数据二=数据二,数据三=数据三 的情况,以及 数据一=数据一,数据二=数据三,数据三=数据二 的情况。

 

你把只需要再加判断即可。应该有6种可能性。


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


加好友 发短信
等级:版主 帖子:85326 积分:427815 威望:0 精华:5 注册:2012/10/18 22:13:00
  发帖心情 Post By:2017/12/18 9:27:00 [显示全部帖子]

那就要组合排列,然后根据组合排列去编写代码,如

 

下载信息  [文件大小:316.0 KB  下载次数:37]
图片点击可在新窗口打开查看点击浏览该文件:排列组合.table


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


加好友 发短信
等级:版主 帖子:85326 积分:427815 威望:0 精华:5 注册:2012/10/18 22:13:00
  发帖心情 Post By:2017/12/18 10:13:00 [显示全部帖子]

参考代码,计算比较慢

 

Dim dt1 As DataTable = DataTables("希望调整后统计结果")
Dim dt2 As DataTable = DataTables("原始数据")
Dim dtb As new DataTableBuilder("测试")
dtb.AddDef("编号", Gettype(String), 32)
dtb.AddDef("数据一", Gettype(String), 32)
dtb.AddDef("数据二", Gettype(String), 32)
dtb.AddDef("数据三", Gettype(String),32)
dtb.Build()
Dim dt3 As DataTable = DataTables("测试")
dt3.AddNew(dt2.DataRows.count)
Dim ary() As String = {"数据一", "数据二", "数据三"}
Dim drs = dt1.Select("科目 <> '总计'")
For Each c As String In ary
    Dim idx As Integer = 0
    For Each dr As DataRow In drs
        For i As Integer = idx To idx+dr(c)-1
            dt3.DataRows(i)(c) = dr("科目")
        Next
        idx += dr(c)
    Next
Next

'求排列
Dim lst_Permutation As List(Of String()) = PermutationAndCombination(Of String).GetPermutation(ary, ary.Length)

For i As Integer = 0 To 54 '测试少量数据
output.show(i)
    Dim dr As DataRow = dt2.DataRows(i)
    Dim temp As String = ""
    For Each ary In lst_Permutation
output.show(ary(0) & " " & ary(1) & " " & ary(2))
        For Each cdr As DataRow In dt3.DataRows
            If cdr.Isnull("编号") Then
                If dr("数据一") = cdr(ary(0)) Then
                    For Each ccdr As DataRow In dt3.DataRows
                        If ccdr.Isnull("编号") Then
                            If dr("数据二") = ccdr(ary(1)) Then
                                For Each cccdr As DataRow In dt3.DataRows
                                    If cccdr.Isnull("编号") Then
                                        If dr("数据三") = cccdr(ary(2)) Then
                                            cdr("编号") = dr("编号")
                                            temp = cdr(ary(2))
                                            cdr(ary(2)) = cccdr(ary(2))
                                            cccdr(ary(2)) = temp
                                            temp = cdr(ary(1))
                                            cdr(ary(1)) = ccdr(ary(1))
                                            ccdr(ary(1)) = temp
                                            goto label1
                                        End If
                                    End If
                                Next
                            End If
                        End If
                    Next
                End If
            End If
        Next
    Next
    label1:
Next
MainTable = Tables("测试")


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


加好友 发短信
等级:版主 帖子:85326 积分:427815 威望:0 精华:5 注册:2012/10/18 22:13:00
  发帖心情 Post By:2017/12/18 10:52:00 [显示全部帖子]

以下是引用xl在2017/12/18 10:46:00的发言:
编译出错提示:未申明名称: “PermutationAndCombination”

Dim lst_Permutation As List(Of String()) = PermutationAndCombination(Of String).GetPermutation(ary, ary.Length)

 

照抄8楼代码,全局代码

 

Public Class PermutationAndCombination(Of T)
 ''' <summary>
 ''' 交换两个变量
 ''' </summary>
 ''' <param name="a">变量1</param>
 ''' <param name="b">变量2</param>
 Public Shared Sub Swap(ByRef a As T, ByRef b As T)
  Dim temp As T = a
  a = b
  b = temp
 End Sub

 ''' <summary>
 ''' 递归算法求数组的组合(私有成员)
 ''' </summary>
 ''' <param name="list">返回的范型</param>
 ''' <param name="t">所求数组</param>
 ''' <param name="n">辅助变量</param>
 ''' <param name="m">辅助变量</param>
 ''' <param name="b">辅助数组</param>
 ''' <param name="M">辅助变量M</param>
 Private Shared Sub GetCombination(ByRef list As List(Of T()), t As T(), n As Integer, m__1 As Integer, b As Integer(), M__2 As Integer)
  For i As Integer = n To m__1 Step -1
   b(m__1 - 1) = i - 1
   If m__1 > 1 Then
    GetCombination(list, t, i - 1, m__1 - 1, b, M__2)
   Else
    If list Is Nothing Then
     list = New List(Of T())()
    End If
    Dim temp As T() = New T(M__2 - 1) {}
    For j As Integer = 0 To b.Length - 1
     temp(j) = t(b(j))
    Next
    list.Add(temp)
   End If
  Next
 End Sub

 ''' <summary>
 ''' 递归算法求排列(私有成员)
 ''' </summary>
 ''' <param name="list">返回的列表</param>
 ''' <param name="t">所求数组</param>
 ''' <param name="startIndex">起始标号</param>
 ''' <param name="endIndex">结束标号</param>
 Private Shared Sub GetPermutation(ByRef list As List(Of T()), t As T(), startIndex As Integer, endIndex As Integer)
  If startIndex = endIndex Then
   If list Is Nothing Then
    list = New List(Of T())()
   End If
   Dim temp As T() = New T(t.Length - 1) {}
   t.CopyTo(temp, 0)
   list.Add(temp)
  Else
   For i As Integer = startIndex To endIndex
    Swap(t(startIndex), t(i))
    GetPermutation(list, t, startIndex + 1, endIndex)
    Swap(t(startIndex), t(i))
   Next
  End If
 End Sub

 ''' <summary>
 ''' 求从起始标号到结束标号的排列,其余元素不变
 ''' </summary>
 ''' <param name="t">所求数组</param>
 ''' <param name="startIndex">起始标号</param>
 ''' <param name="endIndex">结束标号</param>
 ''' <returns>从起始标号到结束标号排列的范型</returns>
 Public Shared Function GetPermutation(t As T(), startIndex As Integer, endIndex As Integer) As List(Of T())
  If startIndex < 0 OrElse endIndex > t.Length - 1 Then
   Return Nothing
  End If
  Dim list As New List(Of T())()
  GetPermutation(list, t, startIndex, endIndex)
  Return list
 End Function

 ''' <summary>
 ''' 返回数组所有元素的全排列
 ''' </summary>
 ''' <param name="t">所求数组</param>
 ''' <returns>全排列的范型</returns>
 Public Shared Function GetPermutation(t As T()) As List(Of T())
  Return GetPermutation(t, 0, t.Length - 1)
 End Function

 ''' <summary>
 ''' 求数组中n个元素的排列
 ''' </summary>
 ''' <param name="t">所求数组</param>
 ''' <param name="n">元素个数</param>
 ''' <returns>数组中n个元素的排列</returns>
 Public Shared Function GetPermutation(t As T(), n As Integer) As List(Of T())
  If n > t.Length Then
   Return Nothing
  End If
  Dim list As New List(Of T())()
  Dim c As List(Of T()) = GetCombination(t, n)
  For i As Integer = 0 To c.Count - 1
   Dim l As New List(Of T())()
   GetPermutation(l, c(i), 0, n - 1)
   list.AddRange(l)
  Next
  Return list
 End Function


 ''' <summary>
 ''' 求数组中n个元素的组合
 ''' </summary>
 ''' <param name="t">所求数组</param>
 ''' <param name="n">元素个数</param>
 ''' <returns>数组中n个元素的组合的范型</returns>
 Public Shared Function GetCombination(t As T(), n As Integer) As List(Of T())
  If t.Length < n Then
   Return Nothing
  End If
  Dim temp As Integer() = New Integer(n - 1) {}
  Dim List As New List(Of T())()
  GetCombination(List, t, t.Length, n, temp, n)
  Return List
 End Function
End Class


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


加好友 发短信
等级:版主 帖子:85326 积分:427815 威望:0 精华:5 注册:2012/10/18 22:13:00
  发帖心情 Post By:2017/12/18 11:27:00 [显示全部帖子]

代码这样写可以提高一些些效率。看懂代码

 

Dim dt1 As DataTable = DataTables("希望调整后统计结果")
Dim dt2 As DataTable = DataTables("原始数据")
Dim dtb As new DataTableBuilder("测试")
dtb.AddDef("编号", Gettype(String), 32)
dtb.AddDef("数据一", Gettype(String), 32)
dtb.AddDef("数据二", Gettype(String), 32)
dtb.AddDef("数据三", Gettype(String),32)
dtb.Build()
Dim dt3 As DataTable = DataTables("测试")
dt3.AddNew(dt2.DataRows.count)
Dim ary() As String = {"数据一", "数据二", "数据三"}
Dim drs = dt1.Select("科目 <> '总计'")
For Each c As String In ary
    Dim idx As Integer = 0
    For Each dr As DataRow In drs
        For i As Integer = idx To idx+dr(c)-1
            dt3.DataRows(i)(c) = dr("科目")
        Next
        idx += dr(c)
    Next
Next

'求排列
Dim lst_Permutation As List(Of String()) = PermutationAndCombination(Of String).GetPermutation(ary, ary.Length)

For i As Integer = 0 To 54 '测试少量数据
    output.show(i)
    Dim flag1,flag2,flag3 As Boolean
    Dim ls1 As new List(Of String)
    Dim ls2 As new List(Of String)
    Dim ls3 As new List(Of String)
    Dim dr As DataRow = dt2.DataRows(i)
    Dim temp As String = ""
    For Each ary In lst_Permutation
        flag1 = False
        flag2 = False
        flag3 = False
        If ls1.Contains(ary(0)) OrElse ls2.Contains(ary(1)) OrElse ls3.Contains(ary(2)) Then
            Continue For
        End If
        output.show(ary(0) & " " & ary(1) & " " & ary(2))
        For Each cdr As DataRow In dt3.DataRows
            If cdr.Isnull("编号") Then
                If dr("数据一") = cdr(ary(0)) Then
                    flag1 = True
                    For Each ccdr As DataRow In dt3.DataRows
                        If ccdr.Isnull("编号") Then
                            If dr("数据二") = ccdr(ary(1)) Then
                                flag2 = True
                                For Each cccdr As DataRow In dt3.DataRows
                                    If cccdr.Isnull("编号") Then
                                        If dr("数据三") = cccdr(ary(2)) Then
                                            flag3 = True
                                            cdr("编号") = dr("编号")
                                            temp = cdr(ary(2))
                                            cdr(ary(2)) = cccdr(ary(2))
                                            cccdr(ary(2)) = temp
                                            temp = cdr(ary(1))
                                            cdr(ary(1)) = ccdr(ary(1))
                                            ccdr(ary(1)) = temp
                                            goto label1
                                        End If
                                    End If
                                Next
                            End If
                        End If
                    Next
                End If
            End If
        Next
        If flag1 = False Then
            ls1.Add(ary(0))
        ElseIf flag2 = False Then
            ls2.Add(ary(1))
        ElseIf flag3 = False Then
            ls3.Add(ary(2))
        End If
    Next
    label1:
Next
MainTable = Tables("测试")


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


加好友 发短信
等级:版主 帖子:85326 积分:427815 威望:0 精华:5 注册:2012/10/18 22:13:00
  发帖心情 Post By:2017/12/18 11:31:00 [显示全部帖子]

看懂例子、看懂代码才能自由扩展。

 

你那样选择,不就直接组合就行了?把四五六七八组合排列成两个的情况。


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


加好友 发短信
等级:版主 帖子:85326 积分:427815 威望:0 精华:5 注册:2012/10/18 22:13:00
  发帖心情 Post By:2017/12/24 15:48:00 [显示全部帖子]


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


加好友 发短信
等级:版主 帖子:85326 积分:427815 威望:0 精华:5 注册:2012/10/18 22:13:00
  发帖心情 Post By:2017/12/24 20:33:00 [显示全部帖子]

 需要手动调整,但可以【半自动】:把不能匹配的编号数据筛选出来,然后重新调整各科、数据一二三的设置,重新执行代码使其匹配。

 回到顶部