[已解决]24点易读短小新编程

lichuanboy44

爱疯 发表于 2016-5-6 11:22
可删吗？

可以，你看怎么处理好就行，你直接移就是。但那边我将问题为已评了最佳了，按要求应标为已解决

爱疯

算了，合并在一起了。

如果问题解决了，自己就编辑1楼，选择主题分类为已解决。

grf1973

去括号

1. 
   
2. sub tt()   
   
3.    arr = Range("a1:a" & [a65536].End(3).Row)
   
4.     ReDim brr(1 To UBound(arr), 1 To 1)
   
5.     Set d = CreateObject("scripting.dictionary")
   
6.     Dim zuo(1 To 2): Dim you(1 To 2)
   
7.     On Error Resume Next
   
8.     For i = 1 To UBound(arr)
   
9.         x = arr(i, 1)
   
10.         y = Replace(Replace(x, "(", ""), ")", "")     '第一种情况：去掉所有括号
    
11.         If Application.Evaluate(y) = 24 Then GoTo 100
    
12.         
    
13.         zz = 0: yy = 0 '记录左右括号位置
    
14.         For k = 1 To Len(x)
    
15.             p = Mid(x, k, 1)
    
16.             If p = "(" Then zz = zz + 1: zuo(zz) = k
    
17.             If p = ")" Then yy = yy + 1: you(yy) = k
    
18.         Next
    
19.         For zz = 1 To 2       '第二种情况：分别去掉各种左右括号组合
    
20.             For yy = 1 To 2
    
21.                 xx = x
    
22.                 Mid(xx, zuo(zz), 1) = "a"
    
23.                 Mid(xx, you(yy), 1) = "a"
    
24.                 y = Replace(xx, "a", "")
    
25.                 js = Application.Evaluate(y)
    
26.                 If InStr(CStr(js), "Error") = 0 Then If js = 24 Then GoTo 100
    
27.             Next
    
28.         Next
    
29.         
    
30.         y = x         '第三种情况：没去掉任何括号
    
31.         
    
32. 100:        brr(i, 1) = y: d(y) = ""
    
33. Next
    
34. ''显示结果：B列是A列去括号后的结果，C列就B列去重后的结果
    
35.     [c1].Resize(d.Count) = Application.Transpose(d.keys)
    
36.     [b1].Resize(i - 1) = brr
    
37.     MsgBox "去括号前" & i - 1 & "组，去括号后" & d.Count & "组"
    
38.    
    
39. End Sub

复制代码