主题：这样的效果能达到吗

 呃，很明细可以。没有做不到的。

 上传你的数据表吧。

把这段代码复制到命令窗口执行一下就行了。

Dim dt_source As DataTable = DataTables("表2")
Dim dt_target As DataTable = DataTables("表3")

dt_target.DataRows.Clear
For Each bh As String In dt_source.GetUniqueValues("", "档案编号")
    Dim drs(3) As DataRow
    drs(0) = dt_target.AddNew
    drs(1) = dt_target.AddNew
    drs(2) = dt_target.AddNew
    drs(3) = dt_target.AddNew
    For Each r As DataRow In drs
        r("档案编号") = bh
    Next
    Dim count As Integer = 1
    Dim xh As New Dictionary(Of String, Integer)
    For Each dr As DataRow In dt_source.Select("档案编号 = '" & bh & "'")
        drs(0)("顺序" & count) = dr("颜色")
        drs(2)("顺序" & count) = dr("尺寸")
        drs(3)("顺序" & count) = dr("机型")
        If xh.ContainsKey(dr("颜色")) Then
            drs(1)("顺序" & xh(dr("颜色"))) &= ";" & dr("序号")
        Else
            drs(1)("顺序" & count) = dr("序号")
            xh.Add(dr("颜色"), count)
            count += 1
        End If
    Next
Next

 你做一个按钮吧。

Dim dt_source As DataTable = DataTables("表2")
Dim dt_target As DataTable = DataTables("表3")

dt_target.DataRows.Clear
For Each bh As String In dt_source.GetUniqueValues("", "档案编号")
    Dim drs(3) As DataRow
    drs(0) = dt_target.AddNew
    drs(1) = dt_target.AddNew
    drs(2) = dt_target.AddNew
    drs(3) = dt_target.AddNew
    For Each r As DataRow In drs
        r("档案编号") = bh
    Next
    Dim count As Integer = 1
    Dim xh As New Dictionary(Of String, Integer)
    For Each dr As DataRow In dt_source.Select("档案编号 = '" & bh & "'")
        drs(0)("顺序" & count) = dr("颜色")
        drs(2)("顺序" & count) = dr("尺寸")
        drs(3)("顺序" & count) = dr("机型")
        If xh.ContainsKey(dr("颜色")) Then
            drs(1)("顺序" & xh(dr("颜色"))) &= ";" & dr("序号")
        Else
            drs(1)("顺序" & count) = dr("序号")
            xh.Add(dr("颜色"), count)
            count += 1
        End If
    Next

    Dim ndr As DataRow = dt_target.AddNew  
    ndr("档案编号") = bh
    For i As Integer = 1 To 20
        If drs(1)("顺序" & i) > "" Then
            ndr("顺序" & i) = drs(1)("顺序" & i).split(";").Length
        End If
    Next
Next

 表事件里的代码

If e.DataCol.Name <> "档案编号" Then
    Dim dt_source As DataTable = e.DataTable
    Dim dt_target As DataTable = DataTables("表3")

    Dim bh As String = e.DataRow("档案编号")   
    dt_target.DeleteFor("档案编号 = '" & bh & "'")
    Dim drs(3) As DataRow
    drs(0) = dt_target.AddNew
    drs(1) = dt_target.AddNew
    drs(2) = dt_target.AddNew
    drs(3) = dt_target.AddNew
    For Each r As DataRow In drs
        r("档案编号") = bh
    Next
    Dim count As Integer = 1
    Dim xh As New Dictionary(Of String, Integer)
    For Each dr As DataRow In dt_source.Select("档案编号 = '" & bh & "'")
        drs(0)("顺序" & count) = dr("颜色")
        drs(2)("顺序" & count) = dr("尺寸")
        drs(3)("顺序" & count) = dr("机型")
        If xh.ContainsKey(dr("颜色")) Then
            drs(1)("顺序" & xh(dr("颜色"))) &= ";" & dr("序号")
        Else
            drs(1)("顺序" & count) = dr("序号")
            xh.Add(dr("颜色"), count)
            count += 1
        End If
    Next
   
    Dim ndr As DataRow = dt_target.AddNew
    ndr("档案编号") = bh
    For i As Integer = 1 To 20
        If drs(1)("顺序" & i) > "" Then
            ndr("顺序" & i) = drs(1)("顺序" & i).split(";").Length
        End If
    Next
End If

 嗯嗯，放错位置了。

Dim dt_source As DataTable = DataTables("表2")
Dim dt_target As DataTable = DataTables("表3")

dt_target.DataRows.Clear
For Each bh As String In dt_source.GetUniqueValues("", "档案编号")
    Dim drs(3) As DataRow
    drs(0) = dt_target.AddNew
    drs(1) = dt_target.AddNew
    drs(2) = dt_target.AddNew
    drs(3) = dt_target.AddNew
    For Each r As DataRow In drs
        r("档案编号") = bh
    Next
    Dim count As Integer = 1
    Dim xh As New Dictionary(Of String, Integer)
    For Each dr As DataRow In dt_source.Select("档案编号 = '" & bh & "'")
        If xh.ContainsKey(dr("颜色")) Then
            drs(1)("顺序" & xh(dr("颜色"))) &= ";" & dr("序号")
        Else
            drs(0)("顺序" & count) = dr("颜色")
            drs(2)("顺序" & count) = dr("尺寸")
            drs(3)("顺序" & count) = dr("机型")
            drs(1)("顺序" & count) = dr("序号")
            xh.Add(dr("颜色"), count)
            count += 1
        End If
    Next
   
    Dim ndr As DataRow = dt_target.AddNew
    ndr("档案编号") = bh
    For i As Integer = 1 To 20
        If drs(1)("顺序" & i) > "" Then
            ndr("顺序" & i) = drs(1)("顺序" & i).split(";").Length
        End If
    Next
Next