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
相关推荐
yivifu3 天前
在VBA中结合正则表达式和查找功能给文档添加交叉连接
正则表达式·word·vba·交叉链接
斐夷所非9 天前
VBA API 概述 / 声明 / 宏编程
vba
lc寒曦21 天前
【VBA实战】使用Word制作简易的考试及阅卷系统
word·vba·考试系统
Access开发易登软件1 个月前
【vba源码】导入excel批注信息
数据库·excel·vba·access
ruleslol1 个月前
VBA10-处理Excel的动态数据区域
excel·vba
lc寒曦1 个月前
【VBA实战】用Excel制作排序算法动画续
排序算法·excel·vba·文档自动化处理
ruleslol2 个月前
VBA02-初识宏——EXCEL录像机
excel·vba
lc寒曦2 个月前
【VBA实战】用Excel制作排序算法动画
排序算法·excel·vba
szial2 个月前
使用VBA宏合并多个Excel文件的Sheet页
excel·vba
taller_20003 个月前
使用VBA快速将文本转换为Word表格
word·vba·表格·word vba·文本转表格