[已解决]请老师再给修改一个代码

dfzc

现在的查找是两数相同不管位置就为有，现修改成两数相同位置也必需相同才算正确，如35必需是35才为正确，否则53就视为无，期待老师修改，谢谢

全列.zip (39.55 KB, 下载次数: 14)

2014-6-4 18:56 上传

点击文件名下载附件

最佳答案

月排行榜 / 总排行榜

芐雨

2014-6-4 19:37

这样？

1. Sub CommandButton2_Click()
   
2.     Dim ARR, BRR, t$, i&, j&, k&, MaxRow&, MaxCol&, AR
   
3.     MaxRow = Cells(Rows.Count, "I").End(xlUp).Row
   
4.     MaxCol = Cells("18", Columns.Count).End(xlToLeft).Column
   
5.     ARR = Range("I18:O" & MaxRow)
   
6.     For n = 0 To MaxCol - 16 Step 4
   
7.         ReDim BRR(1 To UBound(ARR), 1 To 3)
   
8.         AR = Range("P18").Offset(0, n).Resize(UBound(ARR), 1)
   
9.         For i = 1 To UBound(ARR)
   
10.             t = AR(i, 1)
    
11.             For j = 1 To 3
    
12.                 BRR(i, j) = "无"
    
13.                 For k = 2 * j - 1 To 2 * j + 1
    
14.                     If InStr(t, ARR(i, k)) > 0 Then BRR(i, j) = "OK": Exit For
    
15.                 Next
    
16.             Next
    
17.         Next
    
18.         [Q18].Offset(0, n).Resize(UBound(BRR), 3) = BRR
    
19.     Next
    
20.     MsgBox "OK"
    
21. End Sub
    

复制代码

跳转到最佳答案楼层

芐雨

这样？

1. Sub CommandButton2_Click()
   
2.     Dim ARR, BRR, t$, i&, j&, k&, MaxRow&, MaxCol&, AR
   
3.     MaxRow = Cells(Rows.Count, "I").End(xlUp).Row
   
4.     MaxCol = Cells("18", Columns.Count).End(xlToLeft).Column
   
5.     ARR = Range("I18:O" & MaxRow)
   
6.     For n = 0 To MaxCol - 16 Step 4
   
7.         ReDim BRR(1 To UBound(ARR), 1 To 3)
   
8.         AR = Range("P18").Offset(0, n).Resize(UBound(ARR), 1)
   
9.         For i = 1 To UBound(ARR)
   
10.             t = AR(i, 1)
    
11.             For j = 1 To 3
    
12.                 BRR(i, j) = "无"
    
13.                 For k = 2 * j - 1 To 2 * j + 1
    
14.                     If InStr(t, ARR(i, k)) > 0 Then BRR(i, j) = "OK": Exit For
    
15.                 Next
    
16.             Next
    
17.         Next
    
18.         [Q18].Offset(0, n).Resize(UBound(BRR), 3) = BRR
    
19.     Next
    
20.     MsgBox "OK"
    
21. End Sub
    

复制代码

dfzc

芐雨 发表于 2014-6-4 19:37
这样？

老师你太历害了，我看代码几呼没变什么，结果正解，学习了

芐雨

dfzc 发表于 2014-6-4 19:53
老师你太历害了，我看代码几呼没变什么，结果正解，学习了

代码第10行，原代码连接了个反向的字符，使字符一样，位置不同也成立。把它删除了就好。

dfzc

芐雨 发表于 2014-6-4 19:56
代码第10行，原代码连接了个反向的字符，使字符一样，位置不同也成立。把它删除了就好。

谢谢老师指教，刚去掉了第十行，可结果不对，所以保留了

芐雨

dfzc 发表于 2014-6-4 20:07
谢谢老师指教，刚去掉了第十行，可结果不对，所以保留了

我说的删除，是删除连接部分
&后面的