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
相关推荐
VBA633716 小时前
VBA数据库解决方案第二十六讲 工作表中不存在的数据在数据表中批量删除
vba
VBA633717 天前
AI批量PDF数据抓取工具
vba
Access开发易登软件20 天前
我全新开发了一套 Access 通用 Excel 导入工具,现在开源了
数据库·microsoft·excel·mfc·vba·access·access开发
VBA633720 天前
VBA之Word应用第五章第九节 Range对象的方法(三)
vba
wuchunyu00224 天前
VBA 行内容相同时字体变灰
vba
VBA63371 个月前
VBA 64位API声明语句第025讲
vba
Access开发易登软件1 个月前
Access 导入 Markdown 表格:把文档里的数据写进表
前端·html·vba·markdown·access开发
zhongwei2281 个月前
vba将一个文件夹的内容复制到另外一个文件夹的函数,若存在则是否覆盖的参数。复制前检查源文件夹是否存在。若目标文件夹不存在,则新建
前端·vba
Access开发易登软件2 个月前
Access 复杂业务计算,SQL 写在 VBA 还是存储过程?
microsoft·vba·access·access开发
SunnyDays10112 个月前
如何使用 Python 添加和编辑 Excel VBA 宏(无需安装 Excel)
开发语言·python·excel·vba