问题描述
我最近写了一些 VBA 代码，尽管我有一些编码背景，但我认为我在这方面的经验仍然是新的/新鲜的。在提出我自己的问题之前，我已经广泛搜索以查看类似的主题并在那里实施解决方案，但是经过 2 天的搜索/工作，我要么不擅长搜索，要么找不到与我自己的问题类似的解决方案来实施.
我使用的是 Excel 2019。
我有一种每周/每月获得的原始数据，而这个原始数据包含从数千到数万的任何地方行，我的 VBA 代码通过只获取需要的内容来对这个 RAW DATA 进行排序。现在我还想自动化的是从 2 个日期中排除非工作时间。为了实现这一点，我发现了一个复杂的公式，当应用于带有变量的单元格时，它本身就可以工作，但我也想将它包含在我的 VBA 代码中。
我尝试了宏记录器（我尝试了多种方法来获得有关如何实现东西的提示），但我有点坚持这个，因此需要您的专业知识和知识事情。
有问题的公式是：
=(NETWORKDAYS.INTL([@[DC_CREATION_DATE]],[@[ACTUAL_END_DATE]],""0000000"")-1)*(upper-lower)+IF(NETWORKDAYS.INTL([@[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]],lower)"
我的目标是根本没有周末（因此使用 NetworkDays.Intl 使用“0000000”自定义设置所有工作日），并且只设置工作时间（从 0800 到 2300）（8:00AM 到 11 :00PM)，以及从晚上 11:01 到早上 7:59 的任何时间都将被排除在总数之外。
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 & "],MEDIAN(MOD([" & EndDate & "],[" & upper & "],[" & lower & "]),[" & upper & "])" _
& "-MEDIAN(NETWORKDAYS.INTL([" & StartDate & "],[" & StartDate & "],""0000000"")*MOD([" & StartDate & "],[" & lower & "])"
k = k + 1
Next i
Range("U:U").NumberFormat = "General"
End With
' Proceeding to End
这是宏记录器给出的：
ActiveCell.FormulaR1C1 = _
"=(NETWORKDAYS.INTL([@[DC_CREATION_DATE]],""0000000"")-1)*(upper-lower)" & Chr(10) & "+IF(NETWORKDAYS.INTL([@[ACTUAL_END_DATE]],upper)" & Chr(10) & "-MEDIAN(NETWORKDAYS.INTL([@[DC_CREATION_DATE]],lower)"
我尝试过的：
- 将 Range("V" & k).Value 替换为：Formula、FormulaR1C1、Formula2、Formula2R1C1
- 用单元格替换范围
- 尝试使用 Application.WorksheetFunction.NetworkDays_Intl，但我没有足够的经验将整个公式转换为正确的代码。
结果是...没什么，当代码运行时，它没有给出任何错误，但是“V”列完全为空，没有任何值/结果。
我确定我遗漏了一些东西，例如使用带有变量的公式或将公式本身设置为单元格/范围的正确语法，但我已经绞尽脑汁寻求帮助并学习过程。
或者，如果有人有更好的解决方案来排除工作时间而不使用 NetworkDays.Intl（因为没有周末），我也会很感激。
如果已经回答了这样的问题，我深表歉意，并非常感谢您完整地阅读我的帖子。
编辑：在按照 Tim Williams 的建议注释掉“On Error Resume Next”之后，我遇到了一个运行时错误：1004，应用程序定义或对象定义的错误，在我的行上公式已放置。
解决方法
由于贴出的公式准确返回了DC_CREATION_DATE和ACTUAL_END_DATE之间的工作时间，所以问题似乎是如何使用VBA输入Excel公式。
Op 的公式：
= ( NETWORKDAYS.INTL( [@[DC_CREATION_DATE]],[@[ACTUAL_END_DATE]],"0000000" ) -1 ) * ( Upper - Lower )
+ IF( NETWORKDAYS.INTL( [@[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]],Lower )
上面的公式似乎是从 Excel 表格（即 ListObject）中获得的，如以下参数所示：[@[DC_CREATION_DATE]] 和 [@[ACTUAL_END_DATE]]，而 Upper 和 {{1 }} 似乎对应于 Lower
使用标准单元格作为参数的相同公式如下所示：
Defined Names注意参数：= ( NETWORKDAYS.INTL( B7,C7,"0000000" ) -1 ) * ( Upper - Lower )
+ IF( NETWORKDAYS.INTL( C7,MEDIAN( MOD( C7,Upper )
- MEDIAN( NETWORKDAYS.INTL( B7,B7,"0000000" )
* MOD( B7,Lower )
和 [@[DC_CREATION_DATE]] 分别替换为单元格 [@[ACTUAL_END_DATE]] 和 B7
这就是操作代码的问题：
-
它不会替换整个参数
- 仅替换
C7而不是@[DC_CREATION_DATE] - 仅替换
[@[DC_CREATION_DATE]]而不是@[ACTUAL_END_DATE]
- 仅替换
-
此外，它还用
[@[ACTUAL_END_DATE]]和[包裹 Upper 和 Lower
使用 VBA 处理 Excel 公式：
我建议在公式的开头添加对 ] 和 DC_CREATION_DATE 的验证，如下所示：
ACTUAL_END_DATE我提出以下方法来使用 VBA 处理 excel 公式：
- 将公式中的参数替换为在运行过程时将被实际值的
= IF( [@[ACTUAL_END_DATE]] < [@[DC_CREATION_DATE]],( NETWORKDAYS.INTL( [@[DC_CREATION_DATE]],Lower ) )引用替换的关键字：
…
R1C1地点：= IF( #END < #INI," & vbLf & _
( NETWORKDAYS.INTL( #INI,#END,"0000000" ) -1 ) * ( #UPR - #LWR )" & vbLf & _
+ IF( NETWORKDAYS.INTL( #END," & vbLf & _
MEDIAN( MOD( #END,#UPR,#LWR ),#UPR )" & vbLf & _
- MEDIAN( NETWORKDAYS.INTL( #INI,#INI,"0000000" )" & vbLf & _
* MOD( #INI,#LWR ) )"
= #INI[@[DC_CREATION_DATE]] = #END[@[ACTUAL_END_DATE]] = #LWRLower = #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.
- 根据需要为参数定义变量：
…
Const kFmlHours As String = "= IF( #END < #INI," & vbLf & _
" ( NETWORKDAYS.INTL( #INI,""0000000"" ) -1 ) * ( #UPR - #LWR )" & vbLf & _
" + IF( NETWORKDAYS.INTL( #END,""0000000"" )," & vbLf & _
" MEDIAN( MOD( #END,#UPR )" & vbLf & _
" - MEDIAN( NETWORKDAYS.INTL( #INI,""0000000"" )" & vbLf & _
" * MOD( #INI,#LWR ) )"
- 将公式模板中的关键字替换为相应的值或 R1C1 引用：
…
Dim sFmlHours As String
Dim TimeLwr As Double,TimeUpr As Double
Dim sDateIni As String,sDateEnd As String
- 输入整个范围的公式，（您也可以用结果值替换公式）：
…
With .Range("V2")
sDateIni = Range("N2").Address(0,1,xlR1C1,False,.Cells)
sDateEnd = Range("R2").Address(0,.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
程序：
本程序只包括工作时间的计算：
With .Range("V2:V" & lRow)
.FormulaR1C1 = sFmlHours 'Enter formula
.Value = .Value 'Replace Formula with Value
End With
这里有一个潜在的缺陷：
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 & "],""0000000""),MEDIAN(MOD([" & EndDate & "],1),[" & upper & "],[" & lower & "]),[" & upper & "])" _
& "-MEDIAN(NETWORKDAYS.INTL([" & StartDate & "],[" & StartDate & "],""0000000"")*MOD([" & StartDate & "],[" & lower & "])"
k = k + 1
Next i
您正在循环 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
迟到的回复，但请看一看。
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,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) = 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)
DayEt = TimeSerial(23,0)
With WorksheetFunction
Start = .Max(stime,DaySt)
EndTime = .Min(etime,DayEt)
End With
If Start > EndTime Then Exit Function
DayWork = EndTime - Start
End Function
我只是通过使用 excel 公式来完成的，并且我填充的示例数据工作正常
单元格 C2 中使用的公式
conditionally_used_module单元格 D2 中使用的公式
=(NETWORKDAYS.INTL(A2,B2,"0000000")-2)*15
+IF(TIME(23,0)-TIME(HOUR(A2),MINUTE(A2),0)>=TIME(15,0),TIME(15,IF(TIME(HOUR(A2),0)<TIME(23,TIME(23,0))*24
+IF(TIME(HOUR(B2),MINUTE(B2),0)-TIME(8,IF(TIME(HOUR(B2),0)>TIME(8,TIME(HOUR(B2),0))*24
我想要做的是通过将工作时间乘以 15 小时来转换不包括开始和结束日期的工作时间。对于开始日期和完成日期的工作时间，我正在检查它是否在 08:00 和 23:00 之间。以及工作时间。
得到总数后，我再次将它们从总小时数转换为天数、小时数和分钟数，方法是将它们除以天数的 15，剩余的小时数和分钟数