Расчет через VBA для закрытого Excel (рабочая книга) - PullRequest
0 голосов
/ 16 ноября 2018

только начни учиться, и теперь я сталкиваюсь с проблемой.

Я знаю, что могу получить значение из закрытой книги, используя
ExecuteExcel4Macro("'C:\Location\Name\[excel1Test.xlsx]Sheet1'!R3C3") Получение диапазона из закрытой книги в массив

и сделайте расчет стандартного отклонения на открытой рабочей книге

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 функцию для массива C1:C2000 для Sheet1 для excel1Test.xlsx.

Моя проблема - получить массив C1:C2000 и выполнить .StDev для этого массива.

Я очень открыт для новых идей, потому что я не думаю, что мой путь очень умен. Ps: если что-то не ясно, спросите меня.

спасибо за Средний указать. Я забыл одну важную информацию. У excel1Test.xlsx есть много братьев, и все они находятся в одной папке. и все они выглядят примерно одинаково. другими словами, у них всех есть C1:C2000 и Sheet1.

Я получил его , используя ExecuteExcel4Macro (arg) и цикл 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)
    '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+ превосходная, 6 листов / превосходная, где угодно от 5000+ до 100 строк на листах ... я очень медленный код ....

Надеюсь, это поможет ... может быть ... но также я снова ищу помощь, чтобы ускорить этот код.

Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...