在 Excel VBA 中使用 NetworkDays.Intl 作為復雜公式排除非工作時間？

Question

我最近寫了一些 VBA 代碼，但盡管有一些編碼背景，但我認為我的經驗仍然是新的/新鮮的。 在問我自己的問題之前，我已經廣泛搜索以查看類似的主題並在那里實施解決方案，但是經過 2 天的搜索/工作，要么我不擅長搜索，要么就是找不到與我自己的問題類似的解決方案來實施.

我正在使用 Excel 2019。

我有一種我每周/每月獲得的原始數據，這個原始數據包含數千到數萬行，我的VBA代碼通過只獲取需要的內容來對這個原始數據進行排序。 現在我也想自動化是從 2 個日期中排除非工作時間。 為了實現這一點，我遇到了一個復雜的公式，它在應用於帶有變量的單元格時本身就可以工作，但我也想將它包含在我的 VBA 代碼中。

我嘗試了宏記錄器（就像我為多件事做的那樣，以獲得有關如何實現東西的提示），但我有點堅持這個，因此需要你在這件事上的專業知識和知識。

有問題的公式是：

=(NETWORKDAYS.INTL([@[DC_CREATION_DATE]],[@[ACTUAL_END_DATE]],""0000000"")-1)*(upper-lower)+IF(NETWORKDAYS.INTL([@[ACTUAL_END_DATE]],[@[ACTUAL_END_DATE]],""0000000""),MEDIAN(MOD([@[ACTUAL_END_DATE]],1),upper,lower),upper)-MEDIAN(NETWORKDAYS.INTL([@[DC_CREATION_DATE]],[@[DC_CREATION_DATE]],""0000000"")*MOD([@[DC_CREATION_DATE]],1),upper,lower)"

我的目標是根本沒有周末（因此使用 NetworkDays.Intl 將所有自定義設置為使用“0000000”的工作日），並且只設置工作時間（從 0800 到 2300）（上午 8:00 到晚上 11:00） ，以及從晚上 11:01 到早上 7:59 的任何時間都將被排除在總數之外。

這是我實現上述公式的方法的 VBA 代碼：

    Sub RAWDATA_SORT()
    
    Dim Main As Worksheet, Processed As Worksheet
    Dim LastRow As Long, col As Long, k As Integer
    Dim colName As String, maincolName As String
    Dim i As Range
    Dim Headers As Range, SearchHeaders As Range
    Dim upper As Date, lower As Date, StartDate As Date, EndDate As Date
    
    On Error Resume Next
    Set Main = ActiveSheet
    Main.Name = "RAW DATA"
    Sheets.Add(After:=Sheets("RAW DATA")).Name = "Processed Data"
    Set Processed = Sheets("Processed Data")
    Main.Activate
    Main.ShowAllData
    Set Headers = Main.Range("1:1")
    LastRow = 0
    lower = Format(TimeValue("08:00 AM"), "hh:mm AMPM")
    upper = Format(TimeValue("11:00 PM"), "hh:mm AMPM")
    Debug.Print (lower)
    Debug.Print (upper)
    
    ' More Code Here
    
    With Processed
    Processed.Activate
    Processed.AutoFilterMode = False
    Processed.ShowAllData
    
    ' More Code Here

    LastRow = Main.AutoFilter.Range.Columns(1).SpecialCells(xlCellTypeVisible).Cells.Count
    k = 2
    For Each i In Range("N2:N" & LastRow)
        StartDate = Range("N" & k).Value
        EndDate = Range("R" & k).Value
        Debug.Print (StartDate)
        Debug.Print (EndDate)
        Range("U" & k).Value = DateDiff("s", Range("N" & k).Value, Range("R" & k).Value)
        Range("V" & k).Value = "=(NETWORKDAYS.INTL([" & StartDate & "],[" & EndDate & "],""0000000"")-1)*([" & upper & "]- [" & lower & "])" _
                                    & "+IF(NETWORKDAYS.INTL([" & EndDate & "],[" & EndDate & "],""0000000""),MEDIAN(MOD([" & EndDate & "],1),[" & upper & "],[" & lower & "]),[" & upper & "])" _
                                    & "-MEDIAN(NETWORKDAYS.INTL([" & StartDate & "],[" & StartDate & "],""0000000"")*MOD([" & StartDate & "],1),[" & upper & "],[" & lower & "])"
        k = k + 1
    Next i
    Range("U:U").NumberFormat = "General"
End With

    ' Proceeding to End

這是宏記錄器給出的：

ActiveCell.FormulaR1C1 = _
    "=(NETWORKDAYS.INTL([@[DC_CREATION_DATE]],[@[ACTUAL_END_DATE]],""0000000"")-1)*(upper-lower)" & Chr(10) & "+IF(NETWORKDAYS.INTL([@[ACTUAL_END_DATE]],[@[ACTUAL_END_DATE]],""0000000""),MEDIAN(MOD([@[ACTUAL_END_DATE]],1),upper,lower),upper)" & Chr(10) & "-MEDIAN(NETWORKDAYS.INTL([@[DC_CREATION_DATE]],[@[DC_CREATION_DATE]],""0000000"")*MOD([@[DC_CREATION_DATE]],1),upper,lower)"

我試過的：

• 將 Range("V" & k).Value 替換為：公式、公式 R1C1、公式 2、公式 2R1C1
• 用單元格替換范圍
• 嘗試使用 Application.WorksheetFunction.NetworkDays_Intl 但我沒有足夠的經驗將整個公式轉換為正確的代碼。

結果是......什么都沒有，當代碼運行時，它沒有給出任何錯誤，但列“V”是完全空的，沒有任何值/結果。

我確定我錯過了一些東西，例如使用帶有變量的公式或將公式本身設置為單元格/范圍的正確語法，但我已經絞盡腦汁尋求幫助並在此過程中學習。

或者，如果有人有更好的解決方案來排除工作時間而不使用 NetworkDays.Intl（因為沒有周末），我也會很感激。

如果已經回答了這樣的問題，我深表歉意，並非常感謝您完整閱讀我的帖子。

編輯：按照 Tim Williams 的建議注釋掉“On Error Resume Next”后，我在放置公式的行遇到了運行時錯誤：1004，應用程序定義或對象定義錯誤。

Answer 1

由於發布的公式准確地返回了DC_CREATION_DATE和ACTUAL_END_DATE之間的工作時間，問題似乎是關於如何使用 VBA 輸入 Excel 公式。

運算公式：

= ( NETWORKDAYS.INTL( [@[DC_CREATION_DATE]], [@[ACTUAL_END_DATE]], "0000000" ) -1 ) * ( Upper - Lower )
 + IF( NETWORKDAYS.INTL( [@[ACTUAL_END_DATE]], [@[ACTUAL_END_DATE]], "0000000" ),
 MEDIAN( MOD( [@[ACTUAL_END_DATE]], 1 ), Upper, Lower ), Upper )
 - MEDIAN( NETWORKDAYS.INTL( [@[DC_CREATION_DATE]], [@[DC_CREATION_DATE]], "0000000" )
 * MOD( [@[DC_CREATION_DATE]], 1 ), Upper, Lower )

上面的公式似乎是從 Excel 表（即ListObject ）中獲得的，如以下參數所示： [@[DC_CREATION_DATE]]和[@[ACTUAL_END_DATE]] ，而Upper和Lower似乎對應於Defined Names

使用標准單元格作為參數的相同公式將是這樣的：

= ( NETWORKDAYS.INTL( B7, C7, "0000000" ) -1 ) * ( Upper - Lower )
 + IF( NETWORKDAYS.INTL( C7, C7, "0000000" ),
 MEDIAN( MOD( C7, 1 ), Upper, Lower ), Upper )
 - MEDIAN( NETWORKDAYS.INTL( B7, B7, "0000000" )
 * MOD( B7, 1 ), Upper, Lower )

請注意，參數： [@[DC_CREATION_DATE]]和[@[ACTUAL_END_DATE]]分別被單元格B7和C7替換

這就是 Op 代碼的問題：

• 它沒有替換整個參數

  • 僅替換@[DC_CREATION_DATE]而不是[@[DC_CREATION_DATE]]
  • 僅替換@[ACTUAL_END_DATE]而不是[@[ACTUAL_END_DATE]]

• 此外，它還用[和]包裹 Upper 和 Lower

使用 VBA 處理 Excel 公式：

我建議在公式的開頭添加對DC_CREATION_DATE和ACTUAL_END_DATE的驗證，如下所示：

= IF( [@[ACTUAL_END_DATE]] < [@[DC_CREATION_DATE]], 0,
 ( NETWORKDAYS.INTL( [@[DC_CREATION_DATE]], [@[ACTUAL_END_DATE]], "0000000" ) -1 ) * ( Upper - Lower )
 + IF( NETWORKDAYS.INTL( [@[ACTUAL_END_DATE]], [@[ACTUAL_END_DATE]], "0000000" ),
 MEDIAN( MOD( [@[ACTUAL_END_DATE]], 1 ), Upper, Lower ), Upper )
 - MEDIAN( NETWORKDAYS.INTL( [@[DC_CREATION_DATE]], [@[DC_CREATION_DATE]], "0000000" )
 * MOD( [@[DC_CREATION_DATE]], 1 ), Upper, Lower ) )

我提出以下方法來使用 VBA 處理 excel 公式：

1. 將公式中的參數替換為在運行過程時將被實際值的R1C1引用替換的關鍵字：

…

= IF( #END < #INI, 0," & vbLf & _
 ( NETWORKDAYS.INTL( #INI, #END, "0000000" ) -1 ) * ( #UPR - #LWR )" & vbLf & _
 + IF( NETWORKDAYS.INTL( #END, #END, "0000000" )," & vbLf & _
 MEDIAN( MOD( #END, 1 ), #UPR, #LWR ), #UPR )" & vbLf & _
 - MEDIAN( NETWORKDAYS.INTL( #INI, #INI, "0000000" )" & vbLf & _
 * MOD( #INI, 1 ), #UPR, #LWR ) )"

在哪里：
#INI = [@[DC_CREATION_DATE]]
#END = [@[ACTUAL_END_DATE]]
#LWR = Lower
#UPR = Upper

By using the R1C1 reference of the cells we can update the formulas for the entire range at once instead of looping over each cell.

2. 定義一個常量來保存公式模板：

…

Const kFmlHours As String = "= IF( #END < #INI, 0," & vbLf & _
    " ( NETWORKDAYS.INTL( #INI, #END, ""0000000"" ) -1 ) * ( #UPR - #LWR )" & vbLf & _
    " + IF( NETWORKDAYS.INTL( #END, #END, ""0000000"" )," & vbLf & _
    " MEDIAN( MOD( #END, 1 ), #UPR, #LWR ), #UPR )" & vbLf & _
    " - MEDIAN( NETWORKDAYS.INTL( #INI, #INI, ""0000000"" )" & vbLf & _
    " * MOD( #INI, 1 ), #UPR, #LWR ) )"

3. 根據需要為參數定義變量：

…

Dim sFmlHours As String
Dim TimeLwr As Double, TimeUpr As Double
Dim sDateIni As String, sDateEnd As String

4. 將公式模板中的關鍵字替換為相應的值或 R1C1 參考：

…

        With .Range("V2")
            sDateIni = Range("N2").Address(0, 1, xlR1C1, False, .Cells)
            sDateEnd = Range("R2").Address(0, 1, xlR1C1, False, .Cells)
            sFmlHours = kFmlHours
            sFmlHours = Replace(sFmlHours, "#INI", sDateIni)
            sFmlHours = Replace(sFmlHours, "#END", sDateEnd)
            sFmlHours = Replace(sFmlHours, "#LWR", TimeLwr)
            sFmlHours = Replace(sFmlHours, "#UPR", TimeUpr)
        End With

5. 輸入整個范圍的公式， （您也可以將公式替換為結果值） ：

…

        With .Range("V2:V" & lRow)
            .FormulaR1C1 = sFmlHours    'Enter formula
            .Value = .Value             'Replace Formula with Value
        End With

程序：

此程序僅包括工作時間的計算：

Sub Formula_Working_Hours()
   
Const kFmlHours As String = "= IF( #END < #INI, 0," & vbLf & _
    " ( NETWORKDAYS.INTL( #INI, #END, ""0000000"" ) -1 ) * ( #UPR - #LWR )" & vbLf & _
    " + IF( NETWORKDAYS.INTL( #END, #END, ""0000000"" )," & vbLf & _
    " MEDIAN( MOD( #END, 1 ), #UPR, #LWR ), #UPR )" & vbLf & _
    " - MEDIAN( NETWORKDAYS.INTL( #INI, #INI, ""0000000"" )" & vbLf & _
    " * MOD( #INI, 1 ), #UPR, #LWR ) )"

Dim wsMain As Worksheet, wsPrcs As Worksheet
Dim sFmlHours As String
Dim TimeLwr As Double, TimeUpr As Double
Dim sDateIni As String, sDateEnd As String
Dim lRow As Long
    
    Rem Set Lower & Upper Time
    TimeLwr = TimeSerial(8, 0, 0)
    TimeUpr = TimeSerial(23, 0, 0)
    
    With ThisWorkbook
        Set wsMain = .Sheets("RAW DATA")
        Set wsPrcs = .Sheets("Processed Data")
    End With
    
    lRow = wsMain.AutoFilter.Range.Columns(1).SpecialCells(xlCellTypeVisible).Cells.Count
    
    With wsPrcs
                
        .Activate
        If Not (.AutoFilter Is Nothing) Then .AutoFilter.Range.AutoFilter
            
        Rem Set Formula
        With .Range("V2")
            sDateIni = Range("N2").Address(0, 1, xlR1C1, False, .Cells)
            sDateEnd = Range("R2").Address(0, 1, xlR1C1, False, .Cells)
            sFmlHours = kFmlHours
            sFmlHours = Replace(sFmlHours, "#INI", sDateIni)
            sFmlHours = Replace(sFmlHours, "#END", sDateEnd)
            sFmlHours = Replace(sFmlHours, "#LWR", TimeLwr)
            sFmlHours = Replace(sFmlHours, "#UPR", TimeUpr)
        End With
        
        Rem Enter Formula
        With .Range("V2:V" & lRow)
            .FormulaR1C1 = sFmlHours    'Enter formula
            .Value = .Value             'Replace Formula with Value
        End With
        
    End With

End Sub

Answer 2

這里有一個潛在的缺陷：

For Each i In Range("N2:N" & LastRow).SpecialCells(xlCellTypeVisible)
        StartDate = Range("N" & k).Value
        EndDate = Range("R" & k).Value
        Debug.Print (StartDate)
        Debug.Print (EndDate)
        Range("U" & k).Value = DateDiff("s", Range("N" & k).Value, Range("R" & k).Value)
        Range("V" & k).Value = "=(NETWORKDAYS.INTL([" & StartDate & "],[" & EndDate & "],""0000000"")-1)*([" & upper & "]- [" & lower & "])" _
                                    & "+IF(NETWORKDAYS.INTL([" & EndDate & "],[" & EndDate & "],""0000000""),MEDIAN(MOD([" & EndDate & "],1),[" & upper & "],[" & lower & "]),[" & upper & "])" _
                                    & "-MEDIAN(NETWORKDAYS.INTL([" & StartDate & "],[" & StartDate & "],""0000000"")*MOD([" & StartDate & "],1),[" & upper & "],[" & lower & "])"
        k = k + 1
Next i

您正在遍歷 Col N 中的可見單元格，因此我假設此處應用了一些過濾器，並且隱藏了一些行。

如果第一行 (#2) 被隱藏，那么您將從 i=N3 開始，但您的k值仍為 2，因此您正在讀取/寫入與您想要的行不同的行。

在循環中， i.EntireRow將為您提供每個可見行，因此您可以使用（例如）

Dim rw As Range
'....
For Each i In Range("N2:N" & LastRow).SpecialCells(xlCellTypeVisible)
    Set rw = i.EntireRow
    StartDate = rw.Columns("N").Value 'or just i.Value...
    EndDate = rw.Columns("R").Value
    'etc etc

Answer 3

遲來的回復，但看看。

Sub RAWDATA_SORT()
    
    Dim Main As Worksheet, Processed As Worksheet
    Dim LastRow As Long, col As Long, k As Integer
    Dim colName As String, maincolName As String
    Dim i As Long
    Dim Headers As Range, SearchHeaders As Range
    Dim upper As Date, lower As Date, StartDate As Date, EndDate As Date
    
    Dim vR(), vTime()
    
    
    'On Error Resume Next
    Set Main = Sheets("RAW DATA")
    'Main.Name = "RAW DATA"
    'Sheets.Add(After:=Sheets("RAW DATA")).Name = "Processed Data"
    Set Processed = Sheets("Processed Data")
    'Main.Activate
    If Main.FilterMode Then
        Main.ShowAllData
    End If
    Set Headers = Main.Range("1:1")
    LastRow = 0
    'lower = Format(TimeValue("08:00 AM"), "hh:mm AMPM")
    'upper = Format(TimeValue("11:00 PM"), "hh:mm AMPM")
    'Debug.Print (lower)
    'Debug.Print (upper)
    
    ' More Code Here
    
    With Processed
       ' .Activate
        .AutoFilterMode = False
        If .FilterMode Then
            .ShowAllData
        End If
    End With
    ' More Code Here
    'LastRow = Main.AutoFilter.Range.Columns(1).SpecialCells(xlCellTypeVisible).Cells.Count
    LastRow = Main.Range("n" & Rows.Count).End(xlUp).Row
    
    ReDim vR(1 To LastRow, 1 To 1)
    ReDim vTime(1 To LastRow, 1 To 2)
    
    Dim rngDB As Range, vDB
   
    Set rngDB = Main.Range("n2", "R" & LastRow)
    vDB = rngDB
    For i = 1 To UBound(vDB, 1)
        vTime(i, 2) = DayWorkTime(vDB(i, 1), vDB(i, 5))
        vTime(i, 1) = vTime(i, 2) * 24 * 3600
    Next i
        
    With Processed
        .Range("U2").Resize(UBound(vR), 2) = vTime
        .Range("u:u").NumberFormat = "#,##0"
        .Range("v:v").NumberFormat = "[H]:mm"
    End With
    

End Sub

Function DayWorkTime(stime, etime)
    Dim Start As Date, EndTime As Date
    Dim vTime()
    Dim i As Long, k As Integer
    Dim n As Integer
    
    Application.Volatile (0)
 
    If stime > etime Then
        etime = etime + 1
    End If
    k = Int(etime) - Int(stime)
    
    For i = 0 To k
        n = n + 1
        ReDim Preserve vTime(1 To 2, 1 To n)
        If i = 0 Then
            vTime(1, n) = stime - Int(stime)
            vTime(2, n) = 1
        ElseIf k >= 1 Then
            If i = k Then
                vTime(1, n) = 0
                vTime(2, n) = etime - Int(etime)
            Else
                vTime(1, n) = 0
                vTime(2, n) = 1
            End If
        End If
    Next i
        
    For i = 1 To n
        DayWorkTime = DayWorkTime + DayWork(vTime(1, i), vTime(2, i))
    Next i
End Function
Function DayWork(stime, etime)
    Dim DaySt, DayEt
    Dim Start As Date, EndTime As Date
    
    Application.Volatile (0)
    DaySt = TimeSerial(8, 0, 0)
    DayEt = TimeSerial(23, 0, 0)
    With WorksheetFunction
        Start = .Max(stime, DaySt)
        EndTime = .Min(etime, DayEt)
    End With
    If Start > EndTime Then Exit Function
    DayWork = EndTime - Start
End Function

Answer 4

我只是通過使用 excel 公式來做到這一點，並且使用我填充的示例數據工作正常

樣本數據和結果

單元格 C2 中使用的公式

=(NETWORKDAYS.INTL(A2,B2,"0000000")-2)*15
+IF(TIME(23,0,0)-TIME(HOUR(A2),MINUTE(A2),0)>=TIME(15,0,0),TIME(15,0,0),IF(TIME(HOUR(A2),MINUTE(A2),0)<TIME(23,0,0),TIME(23,0,0)-TIME(HOUR(A2),MINUTE(A2),0),0))*24
+IF(TIME(HOUR(B2),MINUTE(B2),0)-TIME(8,0,0)>=TIME(15,0,0),TIME(15,0,0),IF(TIME(HOUR(B2),MINUTE(B2),0)>TIME(8,0,0),TIME(HOUR(B2),MINUTE(B2),0)-TIME(8,0,0),0))*24

單元格 D2 中使用的公式

=ROUNDDOWN(C2/15,0)&" Days "&ROUNDDOWN(MOD(C2,15),0)&" Hours "& MOD(C2,1)*60 & " Minutes"

我要做的是通過將它們乘以 15 小時來轉換不包括開始和結束日期的工作持續時間。 對於開始日期和結束日期的工作時間，我正在檢查它是否在 08:00 到 23:00 之間。 和工作時間。

得到總數后，我再次將它們從總小時數轉換為天數、小時數和分鍾數，除以 15 表示天數，余數表示小時和分鍾