0

我知道我可以使用
ExecuteExcel4Macro("'C:\Location\Name\[excel1Test.xlsx]Sheet1'!R3C3") （https://stackoverflow.com/questions/32015693/getting-a-range-from-a-closed-workbook-into-an-array）从关闭的工作簿中获取值

并对打开的工作簿进行标准偏差计算

Public Function MySdiv(Worksheet As String, lookRange As String) As Double
  Set myRange = Worksheets(Worksheet).Range(lookRange)
  answer = Application.WorksheetFunction.StDev(myRange)
  MySdiv = answer
End Function

我有一个封闭的 Excel，我知道这个 Excel 的名称和路径以及所有内容，我想对 Sheet1 的.StDev数组执行一个函数C1:C2000excel1Test.xlsx.

问题是获取 的数组C1:C2000，并在该数组上执行 a .StDev。

有excel1Test.xlsx很多兄弟，他们都位于同一个文件夹中。它们看起来都有些相似。换句话说，它们都有C1:C2000和Sheet1。

我知道了

通过使用ExecuteExcel4Macro(arg)and 一个While循环来找出数组的大小和一个For循环来填充数组。

Function ArrayOut(strLocation As String, sheet As String, filename As String) As Double()

    Dim RowNum As Long, ref As String, arrWh() As Double, x As Integer, arg As String
    RowNum = 3
    ref = "C" & RowNum

    arg = " '" & strLocation & "[" & filename & "]" & sheet & "'!" & _
            Range(ref).Range("A1").Address(, , xlR1C1)
    x = 1
    Do While Not (ExecuteExcel4Macro(arg) = 0) ' while this cell doesn't equal to 0
        ReDim arrWh(0 To x - 1)
        RowNum = RowNum + 1
        ref = "C" & RowNum
        arg = " '" & strLocation & "[" & filename & "]" & sheet & "'!" & _
            Range(ref).Range("A1").Address(, , xlR1C1)
        x = x + 1
    Loop
    
    RowNum = 3
    x = 1
    ref = "C" & RowNum
    arg = " '" & strLocation & "[" & filename & "]" & sheet & "'!" & _
            Range(ref).Range("A1").Address(, , xlR1C1)
            
    For i = LBound(arrWh) To UBound(arrWh)
        arrWh(i) = ExecuteExcel4Macro(arg)
        RowNum = RowNum + 1
        ref = "C" & RowNum
        arg = " '" & strLocation & "[" & filename & "]" & sheet & "'!" & _
            Range(ref).Range("A1").Address(, , xlR1C1)
    Next i

    RowNum = 3
    x = 1
    ArrayOut = arrWh
End Function

然后将结果放入此函数中：

Function AssiSTDVCal(Arr() As Double) As Double
    Dim Mean As Double, i As Long, x As Long, NewArr() As Double
    ReDim NewArr(UBound(Arr))
    
    Mean = MeanCal(Arr)
    For i = LBound(Arr) To UBound(Arr)
        NewArr(i) = (Arr(i) - Mean) * (Arr(i) - Mean)
    Next i
    
    For x = LBound(NewArr) To UBound(NewArr)
        Sum = Sum + NewArr(x)
    Next x
    AssiSTDVCal = Sqr(Sum / (x - 1))
    
End Function

Function AssistSTDVCal(MeanNum As Double, Arr() As Double) As Double
    Dim i As Long, NewArr(UBound(Arr)) As Double, Sum As Double
    For i = LBound(Arr) To UBound(Arr)
        NewArr(i) = Abs(Arr(i) - MeanNum)
    Next i
    
    Dim x As Long
    For x = LBound(NewArr) To UBound(NewArr)
        Sum = Sum + NewArr(x)
    Next x
    
    AssistSTDVCal = sqrt(Sum / (x - 1))
    
End Function

'Mean calculation
Function MeanCal(Arr() As Double) As Double
    Dim i As Long, Sum As Double, avg As Double
    For i = LBound(Arr) To UBound(Arr)
        Sum = Sum + Arr(i)
    Next i
    avg = Sum / i
    MeanCal = avg
End Function

这段代码非常非常慢。我有 100 多个 Excel 文件，每个文件 6 张，每张 5000 到 100 行不等...

我正在再次寻求帮助以加快此代码的速度。

4

0 回答 0