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

上清宫主

要使只有A1有值时也正常，可把yy代码中的brr =Range("a1:a" & Range("a65536").End(3).Row) 改成brr = Range("a1:a" & Range("a65536").End(3).Row + 1)

yyyydddd8888

上清宫主 发表于 2013-12-22 22:02
把and改成or
只有A1有值时，brr = Range("a1:a" & Range("a65536").End(3).Row)仅是个单变量，而不是数组， ...

谢谢宫主指点，刚才确实没有注意这些细节，真的是细节决定成败啊！

上清宫主

yyyydddd8888 发表于 2013-12-22 22:18
谢谢宫主指点，刚才确实没有注意这些细节，真的是细节决定成败啊！

不是。一般没考虑这个。楼主指定要这样，没法了才用那个办法。只是+1 后，后面的循环终值就要-1了

yyyydddd8888

上清宫主 发表于 2013-12-22 22:25
不是。一般没考虑这个。楼主指定要这样，没法了才用那个办法。只是+1 后，后面的循环终值就要-1了

哦，学习了！你的思路非常巧妙啊！

yyyydddd8888

再修改：
再修改不对3.zip (18.25 KB, 下载次数: 5)

2013-12-22 22:40 上传

点击文件名下载附件

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. 
    

复制代码