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
相关推荐
Access开发易登软件3 天前
Access开发导出PDF的N种姿势,你get了吗?
后端·低代码·pdf·excel·vba·access·access开发
課代表3 天前
VBA 中的 Excel 工作表函数
excel·vba·函数·对象·属性·range·静态变量
Lilixxs3 天前
VBA 中使用 ADODB 操作 SQLite 插入中文乱码问题
数据库·中间件·sqlite·乱码·vba·odbc·adodb
只会HelloWorld的华娃16 天前
VBA模板记录
microsoft·vba
Access开发易登软件1 个月前
Access开发右下角浮窗提醒
microsoft·vba·access·access开发
Access开发易登软件2 个月前
Access开发一键删除Excel指定工作表
服务器·前端·后端·excel·vba·access·access开发
Prodigy_kyw2 个月前
VBA初学3----实战(VBA实现Excel转csv)
excel·vba·csv
yivifu3 个月前
利用VBA将Word文档修改为符合EPUB3标准规范的HTML文件
word·vba·epub
Learn-Share_HY3 个月前
[Excel VBA]如何製作買三送一優惠條件的POS結帳介面?
excel·vba·office·自動化·自動化辦公
shandianchengzi3 个月前
【工具】Quicker/VBA|PPT 在指定位置添加有颜色的参考线
powerpoint·vba·ppt·quicker