VBA使用数组变量调用函数和subs

时间:2016-04-04 19:33:49

标签: arrays vba excel-vba runtime-error excel

所以这里有一个程序可以找到数据集中的最大峰值,然后使用梯形Reimann和积分曲线下面积。有一个主子从一个单独的模块调用子/函数。当我尝试运行此代码时出现"invalid Qualifier"错误,错误发生在模块#2中,行"lowpeakcut(i).Address, _"我不知道这里发生了什么,有没有人有任何见解?如果有人有建议,我也愿意改变我的计划结构。我使用了很多数组来从工作表中调用一次数据,在vba中处理它,然后在最后返回它。

模块#1

Option Explicit

Public sht As Worksheet
Public maxindex() As Long
Public maxval() As Double
Public dataset() As Variant
Public stitle() As String
Public lowpeakcut() As Long
Public highpeakcut() As Long
Public rows As Long
Public columns As Integer
Public p As Long
Public rw As Long
Public areapeak As Double
Public areabelow As Double
Public areaabove As Double
Public a As Double, x1, x2, y1, y2
Public i As Long
Public j As Long
Public Const Minpeaksize As Double = 100
Public Const Fracpeaklimit As Double = 0.05
Sub ArrayOptimized()
'Uses arrays to call data from the sheet once then process it

    'Set sht = ShData
    rows = ShData.Cells(ShData.rows.Count, 1).End(xlUp).Row
    columns = ShData.Cells(1, ShData.columns.Count).End(xlToLeft).Column

    'set array range (includes column titles and xAxix column)
    dataset = ShData.Range(ShData.Cells(1, 1), ShData.Cells(rows, columns))

    ReDim maxindex(1 To columns)
    ReDim maxval(1 To columns)
    ReDim stitle(1 To columns)
    ReDim lowpeakcut(1 To columns)
    ReDim highpeakcut(1 To columns)

    'could also use for i= 2 to columns
    For i = LBound(dataset, 2) To UBound(dataset, 2)

        stitle(i) = dataset(1, i)

        'Note* the "+1" is there cuz column one is the x axis, column data starts in column 2*
        For j = (LBound(dataset, 1) + 1) To UBound(dataset, 1)

            If dataset(j, i) > maxval(i) Then

                maxval(i) = dataset(j, i)
                maxindex(i) = j

            End If


        Next j

        If maxval(i) > Minpeaksize Then

            lowpeakcut(i) = Findmin(maxindex, dataset, maxval, Fracpeaklimit)
            highpeakcut(i) = Findmax(maxindex, dataset, maxval, Fracpeaklimit)

            Sub_Routines.PeakHighlighter
            Sub_Routines.Sums

        End If

    Next i


End Sub

模块#2

Option Explicit
'returns min index for peak area
Function Findmin(maxindex, dataset, maxval, Fracpeaklimit) As Long
'find the "start" index
    Findmin = maxindex(i)
    Do While Findmin > 1 And dataset(Findmin, i) > (maxval(i) * Fracpeaklimit)
        Findmin = Findmin - 1
    Loop
End Function

'returns max index for peak area
Function Findmax(maxindex, dataset, maxval, Fracpeaklimit) As Long
'find the "end" index
    Findmax = maxindex(i)
    Do While Findmax < rows And dataset(Findmax, i) > (maxval(i) * Fracpeaklimit)
        Findmax = Findmax + 1
    Loop
End Function

Sub PeakHighlighter()
'highlight the detected peak....
    With ShData
        .Cells(maxindex(i), i).Interior.ColorIndex = 33
        .Range(.Cells(lowpeakcut(i), i), .Cells(maxindex(i) - 1, i)).Interior.ColorIndex = 7
        .Range(.Cells(maxindex(i) + 1, i), .Cells(highpeakcut(i), i)).Interior.ColorIndex = 50
    End With

End Sub

Sub Sums()

    Dim x1, x2, y1, y2, a As Double

    areabelow = 0
    areapeak = 0
    areaabove = 0

    'sum all the various areas
    For j = 1 To rows - 1

         x1 = dataset(j, 1)
         x2 = dataset(j + 1, 1)
         y1 = IIf(dataset(j, i) <= 0, 1, dataset(j, i)) 'fix negative values
         y2 = IIf(dataset(j + 1, i) <= 0, 1, dataset(j + 1, i))
         a = ((y1 + y2) / 2) * (x2 - x1)

         If j < lowpeakcut(i) Then
             areabelow = areabelow + a
         ElseIf j >= lowpeakcut(i) And j < highpeakcut(i) Then
             areapeak = areapeak + a
         Else
             areaabove = areaabove + a
         End If
    Next j

    Sheets("test").Cells(2, 2).Resize(1, 7).Value = _
               Array(stitle, _
                    lowpeakcut(i).Address, _
                     maxindex(i).Address, _
                     highpeakcut(i).Address, _
                     areabelow, areapeak, areaabove)


End Sub

0 个答案:

没有答案