[已解决]查询数据区间后添加取值---VBA

dabei321

su45 发表于 2014-10-23 12:04
这是修改后的：

进一步测试中发现一到区间后面数就出错，如0-0.249的0.249取值就出现问题而且后面出错的都是区间后面的节点数取值出现了偏差

su45

1. Sub sujsbcl()
   
2. rng1 = Range("A2", Cells(Rows.Count, "A").End(3))
   
3. rng2 = Range("F1").CurrentRegion
   
4. rng3 = Range("I1").CurrentRegion
   
5. ReDim brr(1 To UBound(rng1), 1 To 1)
   
6. ReDim crr(1 To UBound(rng1), 1 To 1)
   
7. For i = 1 To UBound(rng1)
   
8.     For j = 2 To UBound(rng2)
   
9.         If rng1(i, 1) = rng2(j, 1) Then
   
10.             brr(i, 1) = rng2(j, 2)
    
11.             Exit For
    
12.         ElseIf rng1(i, 1) < rng2(j, 1) Then
    
13.             brr(i, 1) = rng2(j - 1, 2)
    
14.             Exit For
    
15.         End If
    
16.     Next
    
17. Next
    
18. For i = 1 To UBound(rng1)
    
19.     For j = 3 To UBound(rng3, 2) Step 2
    
20.         If rng1(i, 1) <= rng3(1, j) Then
    
21.             n = Format(rng1(i, 1), "0.000")
    
22.             n = Right(n, 2)
    
23.             cm = Val(Left(n, 1)): mm = Val(Right(n, 1))
    
24.             crr(i, 1) = rng3(cm + 3, j - 1) + rng3(mm + 3, j)
    
25.             Exit For
    
26.         End If
    
27.     Next
    
28. Next
    
29. Range("B2").Resize(UBound(brr)) = brr
    
30. Range("C2").Resize(UBound(crr)) = crr
    
31. End Sub

复制代码

su45

将 crr(i, 1) = rng3(cm + 3, j - 1) + rng3(mm + 3, j)

改为：

crr(i, 1) = rng3(cm + 3, j - 1) + rng3(mm + 3, j)+brr(i,1)

dabei321

su45 发表于 2014-10-25 13:00
将 crr(i, 1) = rng3(cm + 3, j - 1) + rng3(mm + 3, j)

改为：

Sub sujsbcl()

rng1 = Range("A2", Cells(Rows.Count, "A").End(3))

rng2 = Range("F1").CurrentRegion

rng3 = Range("I1").CurrentRegion

ReDim brr(1 To UBound(rng1), 1 To 1)

ReDim crr(1 To UBound(rng1), 1 To 1)
ReDim drr(1 To UBound(rng1), 1 To 1)

For i = 1 To UBound(rng1)

    For j = 2 To UBound(rng2)

        If rng1(i, 1) = rng2(j, 1) Then

            brr(i, 1) = rng2(j, 2)

            Exit For

        ElseIf rng1(i, 1) < rng2(j, 1) Then

            brr(i, 1) = rng2(j - 1, 2)

            Exit For

        End If

    Next

Next

For i = 1 To UBound(rng1)

    For j = 3 To UBound(rng3, 2) Step 2

        If rng1(i, 1) <= rng3(1, j) Then

            n = Format(rng1(i, 1), "0.000")

            n = Right(n, 2)

            cm = Val(Left(n, 1)): mm = Val(Right(n, 1))
            
            crr(i, 1) = rng3(cm + 4, j - 1) + rng3(mm + 4, j)
            
            
            Exit For

        End If

    Next

Next

Range("B2").Resize(UBound(brr)) = brr
Range("C2").Resize(UBound(crr)) = crr
Range("D2").Resize(UBound(crr)) = crr

End Sub
老师看我乱改的结果还是不对，无法运行，具体的内容我发短信了

su45

你说的：我想将C列取值=B列+C列如何  是不是错了，应该是 我想将D列取值=B列+C列如何  吧？

su45

别发消息，有问题在咱的帖子下回复就行了！

su45

1. Sub sujsbcl()
   
2. rng1 = Range("A2", Cells(Rows.Count, "A").End(3))
   
3. rng2 = Range("F1").CurrentRegion
   
4. rng3 = Range("I1").CurrentRegion
   
5. ReDim brr(1 To UBound(rng1), 1 To 1)
   
6. ReDim crr(1 To UBound(rng1), 1 To 1)
   
7. ReDim drr(1 To UBound(rng1), 1 To 1)
   
8. For i = 1 To UBound(rng1)
   
9.     For j = 2 To UBound(rng2)
   
10.         If rng1(i, 1) = rng2(j, 1) Then
    
11.             brr(i, 1) = rng2(j, 2)
    
12.             Exit For
    
13.         ElseIf rng1(i, 1) < rng2(j, 1) Then
    
14.             brr(i, 1) = rng2(j - 1, 2)
    
15.             Exit For
    
16.         End If
    
17.     Next
    
18. Next
    
19. For i = 1 To UBound(rng1)
    
20.     For j = 3 To UBound(rng3, 2) Step 2
    
21.         If rng1(i, 1) <= rng3(1, j) Then
    
22.             n = Format(rng1(i, 1), "0.000")
    
23.             n = Right(n, 2)
    
24.             cm = Val(Left(n, 1)): mm = Val(Right(n, 1))
    
25.             crr(i, 1) = rng3(cm + 3, j - 1) + rng3(mm + 3, j)
    
26.             Exit For
    
27.         End If
    
28.     Next
    
29.     drr(i, 1) = brr(i, 1) + crr(i, 1)
    
30. Next
    
31. Range("B2").Resize(UBound(brr)) = brr
    
32. Range("C2").Resize(UBound(crr)) = crr
    
33. Range("D2").Resize(UBound(drr)) = drr
    
34. End Sub

复制代码

dabei321

老师猜测和做的没错，是我写错了，我想让F列为检验D列值是否有错误，F3为D3-D2，F4为D4-D3......依次计算，是要那种带公式的值，这样F值出现大的偏差我就可以去查找是计算出错还是输入数值出错了
我用最笨的方法录了个宏
Range("E3").Select
    ActiveCell.FormulaR1C1 = "=RC[-1]-R[-1]C[-1]"
    Range("E3").Select
    Selection.AutoFill Destination:=Range("E3:E20002"), Type:=xlFillDefault
    Range("E4:E20002").Select
    Range("E3").Select
我想将E3:E20002改为D列有数据就执行，能查找到D列最后数据（因为高度可能是0-18米），如D1000有数据执行D1000-D999，D1001无数据就不执行