[已解决]按既定规则，显示结果，求VBA代码。谢谢

chensir

感谢SELECT帮我解决问题，现又增加一个条件，见附件，谢谢

最佳答案

月排行榜 / 总排行榜

zjdh

2011-8-20 09:20

1. Sub TEST()
   
2.     ARR = Range("A2:F" & Range("A65536").End(3).Row)
   
3.     For I = 1 To UBound(ARR)
   
4.         For J = I + 1 To UBound(ARR)
   
5.             If ARR(I, 1) & ARR(I, 4) & ARR(I, 6) = (ARR(J, 1) - 1) & ARR(J, 4) & ARR(J, 6) And ARR(I, 6) = 1 Then
   
6.                 ARR(I, 5) = "同比": ARR(J, 5) = "同比"
   
7.                 Exit For
   
8.             End If
   
9.         Next
   
10.         If ARR(I, 5) = "" And ARR(I, 6) = 1 Then ARR(I, 5) = "非同比"
    
11.     Next
    
12.     Range("A2").Resize(UBound(ARR), 6) = ARR
    
13. End Sub
    

复制代码

跳转到最佳答案楼层

zjdh

1. Sub TEST()
   
2.     ARR = Range("A2:F" & Range("A65536").End(3).Row)
   
3.     For I = 1 To UBound(ARR)
   
4.         For J = I + 1 To UBound(ARR)
   
5.             If ARR(I, 1) & ARR(I, 4) & ARR(I, 6) = (ARR(J, 1) - 1) & ARR(J, 4) & ARR(J, 6) And ARR(I, 6) = 1 Then
   
6.                 ARR(I, 5) = "同比": ARR(J, 5) = "同比"
   
7.                 Exit For
   
8.             End If
   
9.         Next
   
10.         If ARR(I, 5) = "" And ARR(I, 6) = 1 Then ARR(I, 5) = "非同比"
    
11.     Next
    
12.     Range("A2").Resize(UBound(ARR), 6) = ARR
    
13. End Sub
    

复制代码