[求助]超费脑的逻辑判断，求传说级出来指点下~ - 专家坐堂 - Foxtable(狐表) - 新一代数据库软件，完美融合Access、Foxpro、Excel、vb.net之优势，人人都能掌握的快速软件开发工具!

无语，看3楼啊。

第二种

Dim ary1() As String = {"A", "B", "C", "D"}
Dim ary2() As Integer = {-3, 7, -1, -11}

For i As Integer = 0 To ary1.Length - 1
    For j As Integer = 0 To ary2.length - 1
        If i<>j AndAlso Math.Abs(ary2(i)-ary2(j)) < 3 Then
        Dim flag As Boolean = True
            For k As Integer = 0 To ary2.length -1
                If k <> i AndAlso k <> j Then
                    If math.abs(ary2(k)-ary2(i)) < 4 OrElse math.abs(ary2(k)-ary2(j)) < 4 Then
                        flag = False
                        Exit For
                    End If
                End If
            Next
            If flag = True Then
                msgbox(ary1(i) & " " & ary1(j))
                Return Nothing
            End If
        End If
    Next
Next

第三种

Dim ary1() As String = {"A", "B", "C", "D"}
Dim ary2() As Integer = {1, 2, 3, -11}

For i As Integer = 0 To ary1.Length - 1
    For j As Integer = 0 To ary2.length - 1
        If i<>j AndAlso Math.Abs(ary2(i)-ary2(j)) < 3 Then
            For k As Integer = 0 To ary2.length - 1
                If k <> j AndAlso k <> i Then
                    If math.abs(ary2(k)-ary2(i)) < 3 AndAlso math.abs(ary2(k)-ary2(j)) < 3 Then
                        For l As Integer = 0 To ary2.length - 1
                            If l <> i AndAlso l <> j AndAlso l <> k Then
                                If math.abs(ary2(l)-ary2(i)) > 4 AndAlso math.abs(ary2(l)-ary2(j)) > 4 AndAlso math.abs(ary2(l)-ary2(k)) > 4 Then
                                    msgbox(ary1(i) & " " & ary1(j) & " " & ary1(k))
                                    Return Nothing
                                End If
                            End If
                        Next
                    End If
                End If
            Next
        End If
    Next
Next

第四种。

Dim ary1() As String = {"A", "B", "C", "D"}
Dim ary2() As Integer = {1, 2, 3, 0}

For i As Integer = 0 To ary1.Length - 1
    For j As Integer = 0 To ary2.length - 1
        If i<>j AndAlso Math.Abs(ary2(i)-ary2(j)) < 3 Then
            For k As Integer = 0 To ary2.length - 1
                If k <> j AndAlso k <> i Then
                    If math.abs(ary2(k)-ary2(i)) < 3 AndAlso math.abs(ary2(k)-ary2(j)) < 3 Then
                        For l As Integer = 0 To ary2.length - 1
                            If l <> i AndAlso l <> j AndAlso l <> k Then
                                If math.abs(ary2(l)-ary2(i)) > 4 AndAlso math.abs(ary2(l)-ary2(j)) > 4 AndAlso math.abs(ary2(l)-ary2(k)) > 4 Then
                                    msgbox(ary1(i) & " " & ary1(j) & " " & ary1(k))
                                    Return Nothing
                                Else
                                    msgbox("无法判断")
                                    Return Nothing
                                End If
                            End If
                        Next
                    End If
                End If
            Next
        End If

    Next
Next

你好好看看6楼的方法。

无语，问你做好没有又不说。哪用那么麻烦，给你个内部函数：

下载信息 [文件大小：下载次数： ]
点击浏览该文件:气质类型.zip

引用方法：

Functions.Execute("气质类型",胆汁质的值,多血质的值,粘液质的值,抑郁质的值)

如：

Functions.Execute("气质类型",8,7,9,1)

最后在评价上进行赋值出了点问题，我把狐表开发给的内部函数导入到程序，在表的datacolchanged里加入如下代码：

If e.DataCol.Name ="气质类型_胆汁质" Or e.DataCol.Name ="气质类型_多血质" Or e.DataCol.Name ="气质类型_粘液质" Or e.DataCol.Name ="气质类型_抑郁质" Then

Dim qz1 As Integer = e.DataRow("气质类型_胆汁质")

Dim qz2 As Integer = e.DataRow("气质类型_多血质")

Dim qz3 As Integer = e.DataRow("气质类型_粘液质")

Dim qz4 As Integer = e.DataRow("气质类型_抑郁质")

Functions.Execute("气质类型",qz1,qz2,qz3,qz4)

End If

但是赋值出现了问题，如果在后面直接加上

e.DataRow("气质类型_评价") = lxs，提示未定义lxs。

附气质类型内部函数代码

' Args(0) '胆汁质的值

' Args(1) '多血质的值

' Args(2) '粘液质的值

' Args(3) '抑郁质的值

Dim lxs() As String = {"胆汁质","多血质","粘液质","抑郁质"}

Dim dtb As New DataTableBuilder("气质类型Temp")

dtb.AddDef("id", Gettype(Integer))

dtb.AddDef("气质", Gettype(Integer))

dtb.Build()

Dim tb As Table = Tables("气质类型Temp")

tb.Visible = False

Dim n As Integer = Args.Length -1

For i As Integer = 0 To n 'Args.Length -1 ' 3

Dim dr As DataRow = tb.DataTable.AddNew() ' DataTables("气质类型Temp").AddNew()

dr("id") = i

dr("气质") = Args(i)

tb.Sort = "气质" ' DESC"

If tb.Rows(3)("气质") - tb.Rows(2)("气质") > 3 Then

Return lxs(tb.Rows(3)("id"))

ElseIf tb.Rows(2)("气质") - tb.Rows(1)("气质") > 3 Then

tb.Rows(1).Delete()

tb.Rows(0).Delete()

tb.Sort = "" '按数组lxs的顺序返回

Return lxs(tb.Rows(0)("id")) & "," & lxs(tb.Rows(1)("id"))

ElseIf tb.Rows(1)("气质") - tb.Rows(0)("气质") > 3 Then

tb.Rows(0).Delete()

tb.Sort = "" '按数组lxs的顺序返回

Return lxs(tb.Rows(0)("id")) & "," & lxs(tb.Rows(1)("id")) & "," & lxs(tb.Rows(2)("id"))

Else

Return "无法判断"

End If

e.DataRow("气质类型_评价") = Functions.Execute("气质类型",qz1,qz2,qz3,qz4)

感谢大红袍、狐表开发等各位狐友的帮助，现在系统内唯一的缺陷也补全了，工作效率直线上升！！！！再次感受到了狐表功能的强大，在工作效率的优化升级上，狐表绝对的功臣！强烈推荐狐表，再次感谢各位狐友的帮助！

主题：[求助]超费脑的逻辑判断，求传说级出来指点下~