ExcelTip.Net留存知识帖 ---【注：附件之前被网盘供应商清空后，现已修复-现已修复-现已修复为本地下载！】
现在位置：首页 > E问E答 > 综合应用 > 如何用Excel计算24点?

如何用Excel计算24点?

作者：绿色风 分类： 时间：2022-08-18 浏览：338
楼主
xyh9999		 Q:如何用Excel计算24点?
A:用如下自定义函数
Lqc24点.rar


  2. Function Lqc24(n1x, n2x, n3x, n4x, resultx) '计算24点
  3. On Error Resume Next
  4. LqcFH = "+-*/"
  5. LqcSS = ""
  6. LqcSS1 = "="
  7. Dim s(10) As String
  8. tempSS = Val(n1x) & "|" & Val(n2x) & "|" & Val(n3x) & "|" & Val(n4x)
  9. tempSS1 = LqcPL(tempSS)
  10. tempArrSS1 = Split(tempSS1, ";")
  11. ArrLenSS1 = UBound(tempArrSS1)
  12. For ii = 0 To ArrLenSS1 Step 1
  13. tempArrSS2 = Split(tempArrSS1(ii), "|")
  14. n1 = Val(tempArrSS2(0)): n2 = Val(tempArrSS2(1)): n3 = Val(tempArrSS2(2)): n4 = Val(tempArrSS2(3)): result = Val(resultx)
  15. For i1 = 1 To 4 Step 1
  16.   For i2 = 1 To 4 Step 1
  17.     For i3 = 1 To 4 Step 1
  18.       Zf1 = Mid(LqcFH, i1, 1): Zf2 = Mid(LqcFH, i2, 1): Zf3 = Mid(LqcFH, i3, 1)
  19.       s(1) = n1 & Zf1 & n2 & Zf2 & n3 & Zf3 & n4
  20.       s(2) = IIf((Zf1 Like "[+-]"), "(", "") & n1 & Zf1 & n2 & IIf((Zf1 Like "[+-]"), ")", "") & Zf2 & IIf((Zf3 Like "[+-]"), "(", "") & n3 & Zf3 & n4 & IIf((Zf3 Like "[+-]"), ")", "")
  21.       s(3) = IIf((Zf2 Like "[+-]"), "(", "") & IIf((Zf1 Like "[+-]"), "(", "") & n1 & Zf1 & n2 & IIf((Zf1 Like "[+-]"), ")", "") & Zf2 & n3 & IIf((Zf2 Like "[+-]"), ")", "") & Zf3 & n4
  22.       s(4) = IIf((Zf1 Like "[+-]"), "(", "") & n1 & Zf1 & IIf((Zf2 Like "[+-]"), "(", "") & n2 & Zf2 & n3 & IIf((Zf2 Like "[+-]"), ")", "") & IIf((Zf1 Like "[+-]"), ")", "") & Zf3 & n4
  23.       s(5) = n1 & Zf1 & IIf((Zf3 Like "[+-]"), "(", "") & IIf((Zf2 Like "[+-]"), "(", "") & n2 & Zf2 & n3 & IIf((Zf2 Like "[+-]"), ")", "") & Zf3 & n4 & IIf((Zf3 Like "[+-]"), ")", "")
  24.       s(6) = n1 & Zf1 & IIf((Zf2 Like "[+-]"), "(", "") & n2 & Zf2 & IIf((Zf3 Like "[+-]"), "(", "") & n3 & Zf3 & n4 & IIf((Zf3 Like "[+-]"), ")", "") & IIf((Zf2 Like "[+-]"), ")", "")
  25.       s(7) = n1 & Zf1 & IIf((Zf2 Like "[+-]"), "(", "") & n2 & Zf2 & n3 & IIf((Zf2 Like "[+-]"), ")", "") & Zf3 & n4
  26.       s(8) = IIf(((Zf1 Like "[+-]") Or (Zf2 Like "[+-]")), "(", "") & n1 & Zf1 & n2 & Zf2 & n3 & IIf(((Zf1 Like "[+-]") Or (Zf2 Like "[+-]")), ")", "") & Zf3 & n4
  27.       s(9) = n1 & Zf1 & IIf(((Zf2 Like "[+-]") Or (Zf3 Like "[+-]")), "(", "") & n2 & Zf2 & n3 & Zf3 & n4 & IIf(((Zf2 Like "[+-]") Or (Zf3 Like "[+-]")), ")", "")
  28.         For i4 = 1 To 9 Step 1
  29.           If Val(Evaluate(s(i4))) = Val(result) And (Not InStr(LqcSS1, "=" & s(i4) & "=") > 0) Then
  30.             LqcSS1 = LqcSS1 & s(i4) & "="
  31.             If Err.Number > 0 Then
  32.              Err.Clear
  33.             Else
  34.                If LqcSS = "" Then
  35.                   LqcSS = s(i4) & "=" & Val(result)
  36.                Else
  37.                   If (Not InStr(LqcSS, s(i4) & "=") > 0) Then
  38.                     LqcSS = LqcSS & "或" & s(i4) & "=" & Val(result)
  39.                   End If
  40.                End If
  41.             End If
  42.           End If
  43.         Next i4
  44.     Next i3
  45.   Next i2
  46. Next i1
  47. Next ii
  48. If LqcSS = "" Then
  49.     LqcSS = "xyh9999告诉您:" & Val(n1x) & "," & Val(n2x) & "," & Val(n3x) & "," & Val(n4x) & "不可能算出" & Val(result) & "!" & Chr(13) & Chr(10)
  50. Else
  51.     LqcSS = "xyh9999计算结果:" & Chr(13) & Chr(10) & LqcSS
  52. End If
  53. Lqc24 = LqcSS
  54. End Function
  55. Function LqcPL(cSS) '排列
  56. Dim LqcA(), LqcB()
  57. TmpPL = ""
  58. If cSS = "" Then
  59.   LqcPL = TmpPL
  60.   Exit Function
  61. End If
  62. TmpArr = Split(cSS, "|")
  63. UarrLen = UBound(TmpArr)
  64. If UarrLen = 0 Then
  65.   LqcPL = TmpArr(0)
  66.   Exit Function
  67. End If
  68. ReDim LqcA(1, UarrLen)
  69. For i = 0 To UarrLen Step 1
  70.   LqcA(0, i) = TmpArr(i) & ""
  71.   For j = 0 To UarrLen Step 1
  72.     If Not j = i Then
  73.       LqcA(1, i) = LqcA(1, i) & "|" & TmpArr(j) & ""
  74.     End If
  75.   Next j
  76.   If Left(LqcA(1, i), 1) = "|" Then LqcA(1, i) = Right(LqcA(1, i), Len(LqcA(1, i)) - 1)
  77. Next i
  78. Do While 1 = 1
  79. TmpArr = Split(LqcA(1, 0), "|")
  80. UarrLen = UBound(TmpArr)
  81. If UarrLen = 0 Then
  82.   Exit Do
  83. End If
  84. UarrAlen = UBound(LqcA, 2)
  85. UarrBlen = (UarrAlen + 1) * (UarrLen + 1) - 1
  86. ReDim LqcB(1, UarrBlen)
  87. For m = 0 To UarrAlen Step 1
  88.    Temp1 = LqcA(0, m): Temp2 = LqcA(1, m)
  89.    TmpArr = Split(Temp2, "|")
  90.    UarrLen = UBound(TmpArr)
  91.    For n = 0 To UarrLen Step 1
  92.      tt = m * (UarrLen + 1) + n
  93.      LqcB(0, tt) = Temp1 & "|" & TmpArr(n)
  94.      For k = 0 To UarrLen Step 1
  95.        If Not k = n Then
  96.          LqcB(1, tt) = LqcB(1, tt) & "|" & TmpArr(k) & ""
  97.        End If
  98.      Next k
  99.      If Left(LqcB(1, tt), 1) = "|" Then LqcB(1, tt) = Right(LqcB(1, tt), Len(LqcB(1, tt)) - 1)
  100.    Next n
  101. Next m
  102. LqcA = LqcB
  103. Loop
  104. UarrAlen = UBound(LqcA, 2)
  105. For i = 0 To UarrAlen Step 1
  106. temp = LqcA(0, i) & "|" & LqcA(1, i)
  107. If Not InStr(";" & TmpPL & ";", ";" & temp & ";") > 0 Then
  108.    TmpPL = TmpPL & ";" & temp
  109. End If
  110. Next i
  111. If Left(TmpPL, 1) = ";" Then TmpPL = Right(TmpPL, Len(TmpPL) - 1)
  112. LqcPL = TmpPL
  113. End Function
2楼
larkzh		 这个有趣。

免责声明

有感于原ExcelTip.Net留存知识的价值及部分知识具有的时间限定性因素， 经与ExcelTip.Net站长Apolloh商议并征得其同意， 现将原属ExcelTip.Net的知识帖采集资料于本站点进行展示， 供有需要的人士查询使用，也慰缅曾经的论坛时代。 所示各个帖子的原作者如对版权有异议， 可与本人沟通提出，或于本站点留言，我们会尽快处理。 在此，感谢ExcelTip.Net站长Apolloh的支持，感谢本站点所有人**绿色风（QQ:79664738)**的支持与奉献，特此鸣谢！
------本人网名**KevinChengCW（QQ:1210618015)**原ExcelTip.Net总版主之一

猜您喜欢
评论列表
搜索

鄂ICP备2021011689号-2

powered by emlog pro Theme By 蓝叶

sitemap