Excel·VBA二维数组组合函数之穷举推理题

看到一个帖子《CSDN-求助一道推理题》,与之前《python穷举暴力破解《2018年刑侦推理题》用python穷举的推理题很类似

vbnet 复制代码
Sub 穷举推理题()
    Dim x&, y&, z&, a, arr, brr, b, i&, j&, c, crr, t&
    x = 2: y = 8: z = 3  '变量题号
    a = [{"A", "B", "C", "D"}]  '答案类型,答案二维数组
    ReDim arr(1 To 10, 1 To UBound(a)), c(1 To UBound(a))  '答案二维数组,共10题
    For i = 1 To UBound(arr)
        For j = 1 To UBound(arr, 2)
            arr(i, j) = a(j)
        Next
    Next
    tm = Timer: brr = combin_arr2d(arr)  '调用函数返回组合,一维嵌套数组
    For Each b In brr
        If (b(2) = "A" And b(5) = "C") Or (b(2) = "B" And b(5) = "D") Or _
            (b(2) = "C" And b(5) = "A") Or (b(2) = "D" And b(5) = "B") Then  '第2题
            If (b(4) = "A" And b(1) = b(5)) Or (b(4) = "B" And b(x) = b(y)) Or _
                (b(4) = "C" And b(x) = b(z)) Or (b(4) = "D" And b(z) = b(y)) Then  '第4题
                If (b(5) = "A" And b(5) = b(8)) Or (b(5) = "B" And b(5) = b(4)) Or _
                    (b(5) = "C" And b(5) = b(9)) Or (b(5) = "D" And b(5) = b(7)) Then  '第5题
                    If (b(6) = "A" And b(2) = b(4) And b(2) = b(8)) Or _
                        (b(6) = "B" And b(1) = b(6) And b(1) = b(8)) Or _
                        (b(6) = "C" And b(3) = b(10) And b(3) = b(8)) Or _
                        (b(6) = "D" And b(5) = b(9) And b(5) = b(8)) Then  '第6题
                        i = Application.Match(b(1), a, 0)
                        If (b(8) = "A" And Abs(Application.Match(b(7), a, 0) - i) <> 1) Or _
                            (b(8) = "B" And Abs(Application.Match(b(5), a, 0) - i) <> 1) Or _
                            (b(8) = "C" And Abs(Application.Match(b(2), a, 0) - i) <> 1) Or _
                            (b(8) = "D" And Abs(Application.Match(b(10), a, 0) - i) <> 1) Then  '第8题
                            If (b(9) = "A" And ((b(1) = b(6)) <> (b(6) = b(5)))) Or _
                                (b(9) = "B" And ((b(1) = b(6)) <> (b(10) = b(5)))) Or _
                                (b(9) = "C" And ((b(1) = b(6)) <> (b(2) = b(5)))) Or _
                                (b(9) = "D" And ((b(1) = b(6)) <> (b(9) = b(5)))) Then  '第9题
                                For j = 1 To UBound(a)  '字符串计数
                                    crr = Split(Join(b, ""), a(j)): c(j) = UBound(crr)
                                Next
                                t = Application.Match(WorksheetFunction.Min(c), c, 0)
                                If (b(7) = "A" And t = 3) Or (b(7) = "B" And t = 2) Or _
                                    (b(7) = "C" And t = 1) Or (b(7) = "D" And t = 4) Then   '第7题
                                    t = WorksheetFunction.Max(c) - WorksheetFunction.Min(c)
                                    If (b(10) = "A" And t = 3) Or (b(10) = "B" And t = 2) Or _
                                        (b(10) = "C" And t = 4) Or (b(10) = "D" And t = 1) Then  '第10题
                                        Debug.Print "答案", Join(b, "") ': Exit For  '得到1个答案退出
                                    End If
                                End If
                            End If
                        End If
                    End If
                End If
            End If
        End If
    Next
    Debug.Print "累计用时" & Format(Timer - tm, "0.00")  '耗时
End Sub
  • 举例
vbnet 复制代码
x = 1: y = 3: z = 5

运行结果

vbnet 复制代码
答案          DACDCDBCCA
答案          DADBCDCCCC
答案          DDDBBDCBBA
答案          DDDBBDCBBC
累计用时6.04

vbnet 复制代码
x = 2: y = 8: z = 3

运行结果

vbnet 复制代码
答案          DAACCDBCCA
答案          DAACCDBCCC
答案          DACDCDBCCA
答案          DCCCADBAAA
累计用时6.01
相关推荐
LAM LAB2 天前
【VBA/ppt】设置选中字体为红色
powerpoint·vba·wps
零零发聊技术2 天前
Excel实现数字与列标之间的转换
excel·vba·office
Access开发易登软件4 天前
Access 连接 SQL Server:直通查询 vs 链接表 vs ADO,如何选择?
前端·数据库·vba·access·access开发
零零发聊技术5 天前
深度详解VBA+SQL从基础融合到实战应用
sql·vba
零零发聊技术7 天前
聊聊怎样有效学习VBA+SQL?
sql·vba
零零发聊技术8 天前
VBA调用sql语句时不要显示密码
sql·vba
Access开发易登软件11 天前
数据处理中的两大基石:何时选择Excel,何时考虑Access
数据库·信息可视化·excel·vba·access
专注VB编程开发20年16 天前
EDGE估计没有switch到frame的做法
前端·edge·vba
Access开发易登软件17 天前
Access自动生成PPT报告完全指南
数据库·powerpoint·vba·vb·access·access开发
专注VB编程开发20年20 天前
VBA 宏录制的独特优势及替代方案
自动化·vba