excel 用重标极差法求Hurst指数，总是显示溢出

是 否 +2 论坛币

k人 参与回答

经管之家送您一份

应届毕业生专属福利!

求职就业群

赵安豆老师微信：zhaoandou666

经管之家联合CDA

送您一个全额奖学金名额~ !

立即领取

感谢您参与论坛问题回答

经管之家送您两个论坛币！

+2 论坛币

Sub Hurst()

'变量和数组的定义

Dim Data()

Dim Array1()

Dim Array2()

Dim R()

Dim S()

Dim Result()

DimNoOfDataPoints As Integer

DimNoOfPlottedPoints As Integer

Dim NoOfPeriods

Dim PeriodNo

Dim n As Integer

Dim A As Integer

Dim i As Integer

Dim m

Dim e

Dim RS

'验证A 列中是否输入数据

IfWorksheets("Sheet1").Range("A1").Value = 0 Then MsgBox("请在A 列输入数据!"): Exit Sub

'清空主要的单元格

Worksheets("Sheet1").Range("B3").Value= "Hurst = "

Worksheets("Sheet1").Range("C3").Value= Null

'统计数据的个数

i = 1

Do While i <10000

i = i + 1

If Worksheets("Sheet1").Cells(i,1).Value = 0 Then Exit Do

Loop

NoOfDataPoints =i - 1

ReDimData(NoOfDataPoints)

'验证A 列的数据后将其加载到数组中

i = 1

counter = 1

Do While counter<= NoOfDataPoints

Set curCell =Worksheets("Sheet1").Cells(i, 1)

If Application.WorksheetFunction.IsNumber(curCell.Value)Then

Data(counter) =curCell.Value

counter = counter+ 1

End If

i = i + 1

Loop

'运行以下代码则可以直接输入原数据

'i=2

'Do While i <=NoOfDataPoints

'Data(i - 1) =Log(Data(i) / Data(i - 1))

'i = i + 1

'Loop

ReDim Result(NoOfDataPoints/ 2, 2)

'进入主循环

A = 2

Do While A <=NoOfDataPoints / 2

'再次定义数组变量

NoOfPeriods =NoOfDataPoints / A

ReDimArray1(Int(NoOfPeriods))

ReDim Array2(A,NoOfPeriods)

ReDimS(Int(NoOfPeriods))

ReDimR(Int(NoOfPeriods))

RS = 0

'求得各个子区间均值

i = 1

Do While i <=NoOfPeriods

e = 0

For PeriodNo = 1To A

e = e +Data(PeriodNo + (i - 1) * A)

Next PeriodNo

Array1(i) = e / A

i = i + 1

Loop

'求得各个子区间的累积截距和极差

i = 1

Do While i <NoOfPeriods

m = 0

e = 0

For PeriodNo = 1To A

m = m +((Data(PeriodNo + (i - 1) * A) - Array1(i)) ^ 2)

e = e +(Data(PeriodNo + (i - 1) * A) - Array1(i))

Array2(PeriodNo,i) = e

Next PeriodNo

'比较最大值与最小值

Maxi = Array2(1,i)

Mini = Array2(1,i)

For n = 1 To A

If Array2(n, i)> Maxi Then Maxi = Array2(n, i)

If Array2(n, i)< Mini Then Mini = Array2(n, i)

Next n

'求得R/S 值

R(i) = Maxi -Mini

S(i) = Sqr(m / A)

RS = RS + R(i) /S(i)

i = i + 1

Loop

'将V 统计量表的数据输出到Excel表格中

Worksheets("sheet1").Cells(A+ 2, 5).Value = (RS / NoOfPeriods) / Sqr(A)

Worksheets("sheet1").Cells(A+ 2, 6).Value = Log(A)

'将计算结果装入Result（）数组中

Result(A, 1) =Log(A)

Result(A, 2) =Log(RS / NoOfPeriods)

A = A + 1

Loop

'对方程Log(R/S)=Log(c)+ H·Log(n)+ε进行线性回归，估计出斜率H 就是Hurst 指数

sumx = 0

Sumy = 0

Sumxy = 0

Sumxx = 0

NoOfPlottedPoints= NoOfDataPoints / 2

For i = 2 ToNoOfPlottedPoints

sumx = sumx +Result(i, 1)

Sumy = Sumy +Result(i, 2)

Sumxy = Sumxy +(Result(i, 1)) * (Result(i, 2))

Sumxx = Sumxx +(Result(i, 1)) * (Result(i, 1))

Next i

H = (Sumxy -((sumx * Sumy) / NoOfPlottedPoints)) / (Sumxx - ((sumx * sumx) /NoOfPlottedPoints))

Worksheets("sheet1").Range("C3").Value= H

End Sub

这个程序是一篇论文的附录，应该没问题

我实验了，用excel的VBA运行后发现用整数得出的结果应该是正确的，而用我的数据（有很多位小数）就无法运行，总是提示溢出，求解，很急！！！

扫码加我 拉你入群

请注明：姓名-公司-职位

以便审核进群资格，未注明则拒绝

分享0 收藏1 回帖

关键词：Hurst指数 hurst EXCEL exce xcel excel

哥们，您现在会弄了么？求指教！

溢出应该是除以0导致，程序有些不严谨导致的。下面的程序我调试过的，应该没问题了
Sub Hurst()

Dim Data()
Dim Array1()
Dim Array2()
Dim R()
Dim S()
Dim Result()
Dim NoOfDataPoints As Integer
Dim NoOfPlottedPoints As Integer
Dim NoOfPeriods
Dim PeriodNo
Dim n As Integer
Dim A As Integer
Dim i As Integer
Dim m
Dim e
Dim RS

If Worksheets("Sheet1").Range("A1").Value = 0 Then
    MsgBox ("请在A 列输入数据!"):
    Exit Sub
End If

Worksheets("Sheet1").Range("B3").Value = "Hurst = "
Worksheets("Sheet1").Range("C3").Value = Null

i = 1
Do While i < 10000
i = i + 1
If Worksheets("Sheet1").Cells(i, 1).Value = 0 Then Exit Do
Loop
NoOfDataPoints = i - 1
ReDim Data(NoOfDataPoints)

i = 1
counter = 1
Do While counter <= NoOfDataPoints
  Set curCell = Worksheets("Sheet1").Cells(i, 1)
  If Application.WorksheetFunction.IsNumber(curCell.Value) Then
    Data(counter) = curCell.Value
    counter = counter + 1
  End If
  i = i + 1
Loop

'i = 2
'Do While i <= NoOfDataPoints
'Data(i - 1) = Log(Data(i) / Data(i - 1))
'i = i + 1
'Loop
ReDim Result(NoOfDataPoints / 2, 2)

A = 2
Do While A <= NoOfDataPoints / 2

NoOfPeriods = NoOfDataPoints / A
ReDim Array1(Int(NoOfPeriods))
ReDim Array2(A, NoOfPeriods)
ReDim S(Int(NoOfPeriods))
ReDim R(Int(NoOfPeriods))
RS = 0

i = 1
Do While i <= NoOfPeriods
  e = 0
  For PeriodNo = 1 To A
    e = e + Data(PeriodNo + (i - 1) * A)
  Next PeriodNo
  Array1(i) = e / A
  i = i + 1
Loop

i = 1

Do While i < NoOfPeriods
m = 0
e = 0
For PeriodNo = 1 To A
m = m + ((Data(PeriodNo + (i - 1) * A) - Array1(i)) ^ 2)
e = e + (Data(PeriodNo + (i - 1) * A) - Array1(i))
'If m = 0 Then MsgBox ("sdfsd")
Array2(PeriodNo, i) = e
Next PeriodNo

Maxi = Array2(1, i)
Mini = Array2(1, i)
For n = 1 To A
If Array2(n, i) > Maxi Then Maxi = Array2(n, i)
If Array2(n, i) < Mini Then Mini = Array2(n, i)
Next n

R(i) = Maxi - Mini
S(i) = Sqr(m / A)
If S(i) <> 0 Then RS = RS + R(i) / S(i)
i = i + 1
Loop


Worksheets("sheet1").Cells(A + 2, 5).Value = (RS / NoOfPeriods) / Sqr(A)
Worksheets("sheet1").Cells(A + 2, 6).Value = Log(A)

Result(A, 1) = Log(A)
Result(A, 2) = Log(RS / NoOfPeriods)
A = A + 1
Loop

sumx = 0
Sumy = 0
Sumxy = 0
Sumxx = 0
NoOfPlottedPoints = NoOfDataPoints / 2
For i = 2 To NoOfPlottedPoints
sumx = sumx + Result(i, 1)
Sumy = Sumy + Result(i, 2)
Sumxy = Sumxy + (Result(i, 1)) * (Result(i, 2))
Sumxx = Sumxx + (Result(i, 1)) * (Result(i, 1))
Next i
H = (Sumxy - ((sumx * Sumy) / NoOfPlottedPoints)) / (Sumxx - ((sumx * sumx) / NoOfPlottedPoints))
Worksheets("sheet1").Range("C3").Value = H
End Sub