通过VBA计算封闭式excel(工作簿)

时间:2018-11-16 16:53:27

标签: excel vba excel-vba

刚开始学习,现在我正面临挑战。

我知道我可以使用
从封闭的工作簿中获取价值  ExecuteExcel4Macro("'C:\Location\Name\[excel1Test.xlsx]Sheet1'!R3C3") 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,出于某种原因,您只是不想打开它。

但是您知道名称,路径以及与此相关的所有内容。并且您想在.StDev上的Sheet1的数组C1:C2000上执行excel1Test.xlsx.函数

我的问题是获取C1:C2000的数组,然后对该数组执行.StDev

我非常乐于接受新的想法,因为我认为自己的方法不是很聪明。 附言:如果不清楚,问我。

感谢。我忘记了一个重要信息。 excel1Test.xlsx有很多兄弟,他们都位于同一文件夹中。他们看起来都差不多。换句话说,它们都具有C1:C2000Sheet1

我知道了 ,方法是使用ExecuteExcel4Macro(arg)和while循环来查找数组的大小。和for循环来填充数组.... ya

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)
    'MsgBox ExecuteExcel4Macro(arg)
    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
    'MsgBox UBound(arrWh)
    'MsgBox MeanSTDV.StDiv(arrWh)
    'MsgBox MeanSTDV.MeanCal(arrWh)
    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
    'MsgBox avg
    MeanCal = avg
End Function

对不起一些计算功能... 是的,这个代码非常非常!慢...我的数据库是100+ excel,6张/ excel,每张纸从5000+到100行...是非常慢的代码....

我希望这对您有所帮助...也许...但是我也在寻找帮助以加快此代码的速度。

0 个答案:

没有答案