求解：列数据插值一例，VBA实现？

czr0373

条件，2列数：

1.A列从上往下递增，相邻2个数的差值>0.1，

2.B列为一给定的值，比如100，

目标：

1.在A列数值间插值，让其相邻2数差值=0.1，

2.A列插值后，B列与A列原来对应的值不变，

但B列数值上下各增加2个和原来一样的数值

(首尾数例外：首数下面增加1个，尾数上面增加1个)，

其它为0

举例：

源数据第1、2列

目标数据第4、5列.

ykqrs

直接在AB列插？还是保留ab列，结果在另两列？

czr0373

ykqrs 发表于 2018-8-16 10:13
直接在AB列插？还是保留ab列，结果在另两列？

谢谢，直接插AB列

蓝桥玄霜

请见代码。

ykqrs

1. Sub qq()
   
2. Dim r%, i%, j%, arr, brr(1 To 1000, 1 To 2)
   
3. Columns("f:g").Clear
   
4. r = Cells(Rows.Count, 1).End(xlUp).Row
   
5. arr = Range("a2:b" & r)
   
6. j = 1
   
7. For i = 1 To UBound(arr) - 1
   
8. brr(j, 1) = arr(i, 1)
   
9. If i = 1 Then
   
10. brr(j, 2) = arr(i, 2): brr(j + 1, 2) = arr(i, 2)
    
11. Else
    
12. brr(j - 1, 2) = arr(i, 2): brr(j, 2) = arr(i, 2): brr(j + 1, 2) = arr(i, 2)
    
13. End If
    
14. Do
    
15. j = j + 1
    
16. brr(j, 1) = brr(j - 1, 1) + 0.1
    
17. Loop While brr(j, 1) + 0.1 < arr(i + 1, 1)
    
18. j = j + 1
    
19. Next
    
20. brr(j, 1) = arr(i, 1): brr(j, 2) = arr(i, 2): brr(j - 1, 2) = arr(i, 2)
    
21. [f2:g2].Resize(j) = brr
    
22. End Sub
    

复制代码

ykqrs

不知为什么？多出一行，捣鼓了半天，找不到原因

不知道为什么

ykqrs 发表于 2018-8-16 11:21
不知为什么？多出一行，捣鼓了半天，找不到原因

是不是18行代码多了

czr0373

ykqrs 发表于 2018-8-16 11:21
不知为什么？多出一行，捣鼓了半天，找不到原因

已经很好了，非常感谢

ykqrs

不知道为什么 发表于 2018-8-16 11:22
是不是18行代码多了

不多，很奇怪，帮我研究研究

czr0373

蓝桥玄霜 发表于 2018-8-16 11:00
请见代码。

老师，第13行显示下标越界
brr(n, 1) = aa