[已解决]遍历并校对相应信息

庆生妈妈

问卷收集的对象年龄偏小，有的时候答案前后矛盾，想要修改相应数据以便分析。手工修改真是太恐怖了，想请老师帮忙写一小段VBA代码，非常感谢！！
需要遍历的数据是excel表中的第5列，每个单元格有两个数字

1.当遇到空的单元格时，检查对应行的第四列数据，如果为-3，就在单元格填充“0.5 0.5”，否则就不管
2.在遍历这一列数据时，当一个单元格内的两个数字至少有一个<0.5 且 对应行的第4列单元格值为 -3 时，就将该行的第3列和第4列的值都修改为2
3.当第3列单元格的值为1或者2时，如果相应行的第5列值>5.0，就把第5列的这个单元格置空
希望各位大神指点一二~~

最佳答案

月排行榜 / 总排行榜

grf1973

2017-4-10 10:02

1. Sub 校对()
   
2.     arr = Range("a1:j" & [a65536].End(3).Row)
   
3.     For i = 2 To UBound(arr)
   
4.         x = arr(i, 5)
   
5.         
   
6.         If Len(x) = 0 Then  '1.当遇到空的单元格时，检查对应行的第四列数据，如果为-3，就在单元格填充“0.5 0.5”
   
7.             If arr(i, 4) = -3 Then arr(i, 5) = "0.5 0.5"
   
8.         Else
   
9.             xrr = Split(x, " ")
   
10.             '3.当第3列单元格的值为1或者2时，如果相应行的第5列值>5.0，就把第5列的这个单元格置空
    
11.             If arr(i, 3) = 1 Or arr(i, 3) = 2 And (Val(xrr(0)) > 5 Or Val(xrr(UBound(xrr))) > 5) Then
    
12.                 arr(i, 5) = ""
    
13.                 '2.在遍历这一列数据时，当一个单元格内的两个数字至少有一个<0.5 且 对应行的第4列单元格值为 -3 时，就将该行的第3列和第4列的值都修改为2
    
14.             ElseIf Val(xrr(0)) < 0.5 Or Val(xrr(UBound(xrr))) < 0.5 And arr(i, 4) = -3 Then
    
15.                 arr(i, 3) = 2
    
16.                 arr(i, 4) = 2
    
17.             End If
    
18.         End If
    
19.     Next
    
20.     Range("a1:j" & [a65536].End(3).Row) = arr
    
21. End Sub
    

复制代码

跳转到最佳答案楼层

grf1973

1. Sub 校对()
   
2.     arr = Range("a1:j" & [a65536].End(3).Row)
   
3.     For i = 2 To UBound(arr)
   
4.         x = arr(i, 5)
   
5.         
   
6.         If Len(x) = 0 Then  '1.当遇到空的单元格时，检查对应行的第四列数据，如果为-3，就在单元格填充“0.5 0.5”
   
7.             If arr(i, 4) = -3 Then arr(i, 5) = "0.5 0.5"
   
8.         Else
   
9.             xrr = Split(x, " ")
   
10.             '3.当第3列单元格的值为1或者2时，如果相应行的第5列值>5.0，就把第5列的这个单元格置空
    
11.             If arr(i, 3) = 1 Or arr(i, 3) = 2 And (Val(xrr(0)) > 5 Or Val(xrr(UBound(xrr))) > 5) Then
    
12.                 arr(i, 5) = ""
    
13.                 '2.在遍历这一列数据时，当一个单元格内的两个数字至少有一个<0.5 且 对应行的第4列单元格值为 -3 时，就将该行的第3列和第4列的值都修改为2
    
14.             ElseIf Val(xrr(0)) < 0.5 Or Val(xrr(UBound(xrr))) < 0.5 And arr(i, 4) = -3 Then
    
15.                 arr(i, 3) = 2
    
16.                 arr(i, 4) = 2
    
17.             End If
    
18.         End If
    
19.     Next
    
20.     Range("a1:j" & [a65536].End(3).Row) = arr
    
21. End Sub
    

复制代码