主题：分组分道问题

Dim dt As DataTable = DataTables("表A")

dt.ReplaceFor("组别", Nothing, Tables("表A").Filter)

dt.ReplaceFor("道次", Nothing, Tables("表A").Filter)

Dim dws As List(Of String) = dt.GetValues("单位", Tables("表A").Filter)

Dim filter As String = iif(Tables("表A").Filter > "", " and 组别 is null and 道次 is null and " & Tables("表A").Filter, " and 组别 is null and 道次 is null")

Dim rcount As Integer = Tables("表A").Rows.count

Dim msg As String = ""

For i As Integer = 1 To rcount \ 8

    Dim ary(3) As String

    For j As Integer = 1 To 4

        Dim giveup As Integer = 0

        Do While giveup < 10

            Dim dw As String = dws(Rand.Next(dws.count))

            If Array.Indexof(ary, dw) > -1 Then

                giveup += 1

            Else

                Dim fdr As DataRow = dt.Find("单位 = '" & dw & "'" & filter)

                If fdr IsNot Nothing Then

                    fdr("组别") = i

                    fdr("道次") = j

                    ary(j-1) = dw

                    Exit Do

                End If

                

            End If

        Loop

        If giveup >= 10 Then

            Do While 1

                Dim dw As String = dws(Rand.Next(dws.count))

                Dim fdr As DataRow = dt.Find("单位 = '" & dw & "'" & filter)

                If fdr IsNot Nothing Then

                    fdr("组别") = i

                    fdr("道次") = j

                    ary(j-1) = dw

                    Exit Do

                End If

            Loop

        End If

    Next

    For j As Integer = 5 To 8

        Dim fdr As DataRow = dt.Find("单位 = '" & ary(j-5) & "'" & filter)

        If fdr Is Nothing Then

            msg += "(" & i & "," & j & ")缺值" & vbcrlf

        Else

            fdr("组别") = i

            fdr("道次") = j

        End If

    Next

Next

output.show(msg)

Tables("表A").sort = "组别, 道次"