[已解决]求助排列问题。

cocolili

000-999这1000个排列.去除A列中的组合.余下的排列填入B列..

最佳答案

月排行榜 / 总排行榜

yyyydddd8888

2013-12-22 22:40

再修改：
(, 下载次数: 5)

上传

点击文件名下载附件

1. Option Explicit
   
2. 
   
3. Sub 排除()
   
4. Dim arr$(1 To 1000, 1 To 1), st$, brr, i&, j&, k&, st1$, st2$
   
5. Dim s1$, s2$, s3$, s4$, s5$, s6$
   
6. brr = Range("a1:a" & Range("a65536").End(3).Row)
   
7. For i = 1 To 1000
   
8.     st = Format(i - 1, "000")
   
9.     If IsArray(brr) Then
   
10.         For j = 1 To UBound(brr)
    
11.              If brr(j, 1) <> "" Then
    
12.                 st1 = Mid(brr(j, 1), 1, 1)
    
13.                 st2 = Mid(brr(j, 1), 2, 1)
    
14.                 s1 = "*" & st1 & st2
    
15.                 s2 = "*" & st2 & st1
    
16.                 s3 = st1 & "*" & st2
    
17.                 s4 = st1 & st2 & "*"
    
18.                 s5 = st2 & "*" & st1
    
19.                 s6 = st2 & st1 & "*"
    
20.                  If st Like s1 Or st Like s2 Or st Like s3 Or st Like s4 Or st Like _
    
21.                  s5 Or st Like s6 Then GoTo ppp
    
22.              End If
    
23.         Next j
    
24.     Else
    
25.              If brr <> "" Then
    
26.                 st1 = Mid(brr, 1, 1)
    
27.                 st2 = Mid(brr, 2, 1)
    
28.                 s1 = "*" & st1 & st2
    
29.                 s2 = "*" & st2 & st1
    
30.                 s3 = st1 & "*" & st2
    
31.                 s4 = st1 & st2 & "*"
    
32.                 s5 = st2 & "*" & st1
    
33.                 s6 = st2 & st1 & "*"
    
34.                  If st Like s1 Or st Like s2 Or st Like s3 Or st Like s4 Or st Like _
    
35.                  s5 Or st Like s6 Then GoTo ppp
    
36.              End If
    
37.     End If
    
38.     k = k + 1
    
39.     arr(k, 1) = st
    
40. ppp:
    
41. Next i
    
42. Columns(2) = ""
    
43. Range("b1").Resize(k) = arr
    
44. End Sub
    
45. 
    
46. 
    

复制代码

跳转到最佳答案楼层

cocolili

再顶上去，看看有没解答。

yyyydddd8888

请测试：
不含2数.zip (15.21 KB, 下载次数: 6)

2013-12-22 20:01 上传

点击文件名下载附件

cocolili

yyyydddd8888 发表于 2013-12-22 20:01
请测试：

是这样,但是这种情况不运行代码是什么原因.A列也是文本形式.

cocolili

yyyydddd8888 发表于 2013-12-22 20:01
请测试：

结果还是有错误,老师看看是什么原因呢.

yyyydddd8888

cocolili 发表于 2013-12-22 20:26
结果还是有错误,老师看看是什么原因呢.

现在应该没问题了，请测试：
不对..rar (15.28 KB, 下载次数: 6)

2013-12-22 21:08 上传

点击文件名下载附件

cocolili

yyyydddd8888 发表于 2013-12-22 21:08
现在应该没问题了，请测试：

还是不对哦.

cocolili

yyyydddd8888 发表于 2013-12-22 21:08
现在应该没问题了，请测试：

还是不对,见附件.

yyyydddd8888

cocolili 发表于 2013-12-22 21:22
还是不对,见附件.

刚才搞得太忙了，把or 写成了 and
现在应该没有问题了，请测试：

修改不对3.zip (20.37 KB, 下载次数: 2)

2013-12-22 22:17 上传

点击文件名下载附件

上清宫主

把and改成or
只有A1有值时，brr = Range("a1:a" & Range("a65536").End(3).Row)仅是个单变量，而不是数组，所以程序出错。把他处理一下就可以了