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
相关推荐
szial3 天前
使用VBA宏合并多个Excel文件的Sheet页
excel·vba
taller_20001 个月前
使用VBA快速将文本转换为Word表格
word·vba·表格·word vba·文本转表格
arvinzd1 个月前
VBA解除Excel工作表保护
excel·vba
maizeman1262 个月前
excel VBA进行间比法设计
excel·vba·间比法·品比试验
oennn欧冷2 个月前
中文关键字检索分析-导出到csv或者excel-多文件或文件夹-使用python和asyncio和pandas的dataframe
python·pandas·vba·asyncio·dataframe·completablefuture
rousseaou82 个月前
Weibull概率分布纸(EXCEL VBA实现)
excel·vba·weibull·weibull概率纸·可靠性理论
Script_Man2 个月前
VBA进行excel坐标转换
算法·自动化·vba·坐标转换·combobox·excel画图
jOkerSdl2 个月前
在VBA中,对Excel单元格的操作方法 (qo+op)
excel·vba
jOkerSdl2 个月前
在VBA中调用Adobe Acrobat或Reader的命令行工具,实现PDF自动打印 (‾◡◝)
pdf·vba
营赢盈英2 个月前
OpenAI API VBA function returns #Value! but MsgBox displays response
ai·excel·vba·openai api·worksheet