Использование Sumifs в диапазоне в отдельной электронной таблице

Question

В настоящее время я выполняю расчет суммы Sumifs, используя следующий код

 Public Function WFPAID(rev_date As Date) As Variant

  Application.Volatile (True)

  Set Vstatus = Sheets("KRONOS").Range("$DL:$DL")
  Set Team = Sheets("KRONOS").Range("$DO:$DO")
  Set WF_Paydate = Sheets("KRONOS").Range("$DK:$DK")

            WFPAID = Application.WorksheetFunction.SumIfs( _
            Writer_Fee _
            , Team, "<>9" _
            , Vstatus, "<>rejected", Vstatus, "<>unverified" _
            , WF_Paydate, rev_date)

 End Function

Имя моего файла Excel - DATADUMP, и оно сохраняется на нашем сервере в следующем месте U:\DATADUMP.xlsx.Я хотел бы предварительно вычислить расчет Sumifs в U:\DATADUMP.xlsx Sheet.KRONOS из другого Excel под названием NEWCAL.

Можно ли помочь, пожалуйста.

Answer 1

Вставьте этот код в модуль в NEWCALC.xlsx и запустите как макрос. Он выведет результат вычисления SumIfs в ячейку в NEWCALC.

Sub CalculateSumIfsOnDATADUMP()

Dim wb As Workbook
Dim Vstatus As Range, Team As Range, WF_Paydate As Range, Writer_Fee As Range
Dim WFPAID As Variant
Dim rng As Range
Dim colCOUNT As Long

    '// turn off screen updating
    Application.ScreenUpdating = False

    '// open the source workbook as read only
    Set wb = Workbooks.Open("U:\DATADUMP.xlsx", ReadOnly:=True)

    ThisWorkbook.ActiveSheet.Activate

    For Each rng In Application.Selection
    rev_date = rng.Value

        With wb.Worksheets("KRONOS")

            '// Set range variables for SumIfs calculation
            '// (NOTE: 'Writer_Fee' range needs to be supplied)
            Set Writer_Fee = .Range("Something")
            Set Vstatus = .Range("$DL:$DL")
            Set Team = .Range("$DO:$DO")
            Set WF_Paydate = .Range("$DK:$DK")

            '// Do the SumIfs Calculation, and store in WFAID
            WFPAID = Application.WorksheetFunction.SumIfs(Writer_Fee, _
                                                          Team, "<>9", _
                                                          Vstatus, "<>rejected", _
                                                          Vstatus, "<>unverified", _
                                                          WF_Paydate, "=" & rev_date)
        End With

        '// Output the calculation result to a cell in the ActiveSheet
        ActiveSheet.Cells(rng.Row, rng.Column + Selection.Columns.Count) = WFPAID

    Next rng

    '// close the source workbook without saving any changes
    wb.Close False

    '// turn on screen updating
    Application.ScreenUpdating = True

End Sub

EDIT
Я изменил код, чтобы прочитать выбранный диапазон, и вывести результат SumIfs в столбце рядом с ним.

Answer 2

Я хотел опубликовать другой метод для этого, который я не знал, был возможен. Согласно Чип Пирсон , вы можете:

вызовите UDF, который содержится в другой (открытой) рабочей книге, используя имя рабочей книги в формуле. Например: ='MyBook.xls'!RectangleArea(A1,A2)

Таким образом, это означает, что другой метод вызова вашей UDF - убедиться, что другой WB открыт: Workbooks.Open("U:\DATADUMP.xlsx", ReadOnly:=True)

Затем на другом листе убедитесь, что функция выглядит следующим образом: ='DATADUMP.xlsx'!WFPAID([Cells reference to dat])

Кажется, гораздо проще реализовать вашу цель. Вы можете добавить это к vba, если вам нужно, но вы также можете ограничить время расчета листа или выполнить команду copy - pasteValues, чтобы сохранить результаты.

Answer 3

Предполагая, что "DATADUMP.xlsx" уже открыт, вы можете попробовать что-то вроде этого:

Public Function WFPAID(rev_date As Date) As Variant
   Dim objWorksheet As Excel.Worksheet

    Dim objWriterFee As Excel.Range
    Dim objStatus As Excel.Range
    Dim objTeam As Excel.Range
    Dim objPaydate As Excel.Range

    Application.Volatile (True)

    ' This assumes "DATADUMP.xlsx" is already open.
    Set objWorksheet = Application.Workbooks("DATADUMP.xlsx").Worksheets("KRONOS")

    ' Change the next line to set the "writer fee" to a valid range.
    Set objWriterFee = objWorksheet.Range("?")
    Set objStatus = objWorksheet.Range("$DL:$DL")
    Set objTeam = objWorksheet.Range("$DO:$DO")
    Set objPaydate = objWorksheet.Range("$DK:$DK")

    WFPAID = _
        Application.WorksheetFunction.SumIfs _
        ( _
             objWriterFee, _
             objTeam, "<>9", _
             objStatus, "<>rejected", objStatus, "<>unverified", _
             objPaydate, rev_date _
        )
End Function

Однако, если "DATADUMP.xlsx" не уже открыт, вы не сможете открыть его в текущем приложении во время пересчета.