[已解决]修改代码

759857387 · 发表于 2016-6-11 22:50

求助：将aa、xx合并成一个过程
说明：aa过程是已经做好的

用代码计算黄色数据_1.rar (11.1 KB, 下载次数: 8)

2016-6-11 22:50 上传

点击文件名下载附件

最佳答案

月排行榜 / 总排行榜

老司机带带我

2016-6-11 23:19

你看这样行了没！

Sub aa()
arr = [a5:a20]
brr = [b5:b20]
For i = 1 To UBound(brr) '寻找B数组的开始行号和结束行号
If brr(i, 1) = "" Then
If i1 = 0 And brr(i + 1, 1) <> "" Then
i1 = i + 1 'B数组的开始行号
ElseIf i1 > 0 Then
i2 = i - 1: Exit For 'B数组的结束行号
End If
End If
Next
ReDim crr(1 To i2 - i1 + 1, 1 To 1) '声明动态数组变量crr 1 to 4
ReDim drr(1 To i2 - i1 + 1, 1 To 1) '声明动态数组变量drr
n = 0
For i = i1 To i2
n = n + 1
drr(n, 1) = brr(i, 1) 'B数组写入drr
Next
Max = 0
For i = 1 To UBound(arr) - n + 1 '循环维度的最大值13-n4的第一行
For ii = 1 To n '循环 1 to 4
crr(ii, 1) = arr(i + ii - 1, 1) '将A数组1 to 4写入crr
Next
xsdu = Application.Correl(crr, drr) '启用Correl(crr, drr)函数，并将结果写入xsdu（变量）
If Max < xsdu Then Max = xsdu: i0 = i '自Max=0开始降序排列xsdu变量，最后将最大xsdu写入Max，i0 = i是对应行的意思
Next
[b24] = Max '将结果写入[b24]
[b5:b20] = "" '清空[b5:b20]
Range("b4").Offset(i0, 0).Resize(n, 1) = drr '将B数组写入Range("b4")开维的比对开始范围(i0, 0)的n + 1
Call xx
End Sub
Sub xx()
Dim i&, x%, a As Double, b As Double, c As Double, n&
x = 3
With Sheet1
n = .Cells(22, 2).End(xlUp).Row + 1
For i = n To 20
a = Application.Evaluate("INDEX(LINEST(B" & i - 4 & ":" & "B" & i - 1 & ",A" & i - 4 & ":A" & i - 1 & "^{1,2},TRUE,TRUE),1,1)")
b = Application.Evaluate("INDEX(LINEST(B" & i - 4 & ":" & "B" & i - 1 & ",A" & i - 4 & ":A" & i - 1 & "^{1,2},TRUE,TRUE),1,2)")
c = Application.Evaluate("INDEX(LINEST(B" & i - 4 & ":" & "B" & i - 1 & ",A" & i - 4 & ":A" & i - 1 & "^{1,2},TRUE,TRUE),1,3)")
.Range("B" & i) = a * .Range("A" & i) ^ 2 + b * .Range("A" & i) + c
x = x + 1
Next
End With
End Sub

复制代码

跳转到最佳答案楼层

老司机带带我 · 发表于 2016-6-11 22:56

你的aa这个代码有问题吧？请把aa这个模块更新下！

759857387 · 发表于 2016-6-11 23:08

老司机带带我发表于 2016-6-11 22:56
你的aa这个代码有问题吧？请把aa这个模块更新下！

先把黄色数据清除。
B数组，同列上移一行，运行过程aa，看结果。

老司机带带我 · 发表于 2016-6-11 23:14

本帖最后由老司机带带我于 2016-6-11 23:15 编辑

上移运行之后结果如图，然后再计算15-20行？
QQ截图20160611230607.jpg

759857387 · 发表于 2016-6-11 23:15

老司机带带我发表于 2016-6-11 22:56
你的aa这个代码有问题吧？请把aa这个模块更新下！

aa过程运行后BB数组具体在哪一行，运行前不知道（动态的），xx过程中13 to 22也不能定死，要改了。

老司机带带我 · 发表于 2016-6-11 23:19

你看这样行了没！

Sub aa()
arr = [a5:a20]
brr = [b5:b20]
For i = 1 To UBound(brr) '寻找B数组的开始行号和结束行号
If brr(i, 1) = "" Then
If i1 = 0 And brr(i + 1, 1) <> "" Then
i1 = i + 1 'B数组的开始行号
ElseIf i1 > 0 Then
i2 = i - 1: Exit For 'B数组的结束行号
End If
End If
Next
ReDim crr(1 To i2 - i1 + 1, 1 To 1) '声明动态数组变量crr 1 to 4
ReDim drr(1 To i2 - i1 + 1, 1 To 1) '声明动态数组变量drr
n = 0
For i = i1 To i2
n = n + 1
drr(n, 1) = brr(i, 1) 'B数组写入drr
Next
Max = 0
For i = 1 To UBound(arr) - n + 1 '循环维度的最大值13-n4的第一行
For ii = 1 To n '循环 1 to 4
crr(ii, 1) = arr(i + ii - 1, 1) '将A数组1 to 4写入crr
Next
xsdu = Application.Correl(crr, drr) '启用Correl(crr, drr)函数，并将结果写入xsdu（变量）
If Max < xsdu Then Max = xsdu: i0 = i '自Max=0开始降序排列xsdu变量，最后将最大xsdu写入Max，i0 = i是对应行的意思
Next
[b24] = Max '将结果写入[b24]
[b5:b20] = "" '清空[b5:b20]
Range("b4").Offset(i0, 0).Resize(n, 1) = drr '将B数组写入Range("b4")开维的比对开始范围(i0, 0)的n + 1
Call xx
End Sub
Sub xx()
Dim i&, x%, a As Double, b As Double, c As Double, n&
x = 3
With Sheet1
n = .Cells(22, 2).End(xlUp).Row + 1
For i = n To 20
a = Application.Evaluate("INDEX(LINEST(B" & i - 4 & ":" & "B" & i - 1 & ",A" & i - 4 & ":A" & i - 1 & "^{1,2},TRUE,TRUE),1,1)")
b = Application.Evaluate("INDEX(LINEST(B" & i - 4 & ":" & "B" & i - 1 & ",A" & i - 4 & ":A" & i - 1 & "^{1,2},TRUE,TRUE),1,2)")
c = Application.Evaluate("INDEX(LINEST(B" & i - 4 & ":" & "B" & i - 1 & ",A" & i - 4 & ":A" & i - 1 & "^{1,2},TRUE,TRUE),1,3)")
.Range("B" & i) = a * .Range("A" & i) ^ 2 + b * .Range("A" & i) + c
x = x + 1
Next
End With
End Sub

复制代码

		自动登录	找回密码
密码			注册

[已解决]修改代码

评分