Question

我们有一家产品制造商，我们（非正式地）“雇用”每个想要帮助的人，我们根据他们工作的天数（在每个学期末）向他们付款，这是因为我们无法适当地控制现金流量。主要是因为我们有很多人在一周到两个月的时间里工作。现在我们有了一张简单的Excel工作表，其中应用了我发现的here和here的解决方案。

尽管对我们的会计师而言非常有用且易于阅读，但需要花费大量时间来处理（此工作表几乎存储了公司的所有内容，+ 50k记录和约10mb的数据），而且我们仍然必须处理每个月的付款，每个工人都要手工。我想构建一个VBA脚本，该脚本可以存储一个简单的excel函数，该函数可以将月份分割为几个月（显示为新行），也可以仅复制/粘贴行并用新的时期覆盖它们，如下所示：

我设法检测x周期是否涉及一个多月，然后将其复制/粘贴到其他工作表中，但是我无法在VBA上找到能够做到这一点的方法/逻辑。任何提示表示赞赏。

Sub mainFunc()
Hoja1 = Worksheets("Sheet1").Cells(Rows.Count, 1).End(xlUp).Row

Dim dateS As Date 'Start Date
Dim dateE As Date 'End Date

For i = 2 To Hoja1
    If IsDate(Range("$B2")) And IsDate(Range("$C2")) Then
        dateS = Range("$B2")
        dateE = Range("$C2")
        If Month(dateE) > Month(dateS) Then
            'If end month is lesser or equal to start date then
            'The month spliter should go here and it should copypaste it in another sheet
            Worksheets("Sheet1").Rows(i).Copy
            Worksheets("Sheet2").Activate
            Hoja2 = Worksheets("Sheet2").Cells(Rows.Count, 1).End(xlUp).Row
            Worksheets("Sheet2").Cells(Hoja2 + 1, 1).Select
            ActiveSheet.Paste
            Worksheets("Sheet1").Activate

            Else
            'Else (same month) should just copypaste the same row, no changes
            Worksheets("Sheet1").Rows(i).Copy
            Worksheets("Sheet2").Activate
            Hoja2 = Worksheets("Sheet2").Cells(Rows.Count, 1).End(xlUp).Row
            Worksheets("Sheet2").Cells(Hoja2 + 1, 1).Select
            ActiveSheet.Paste
            Worksheets("Sheet1").Activate
            End If
    End If

Next
Application.CutCopyMode = False
ThisWorkbook.Worksheets("Sheet1").Cells(1, 1).Select
End Sub

Answer 1

假设：

您的源数据在名为"Sheet1"的工作表上，其中A列为"member"，B列为"day start"，C列为"day exit"
您正在将数据输出到名为"Sheet2"的工作表中

下面的代码应该给您一些实现目标的想法（它给了我您第二个屏幕快照中显示的内容，但自从我使用NETWORKDAYS函数以来的工作天数除外）。

Option Explicit

Sub SplitPayDataIntoMonths()

    Dim destinationSheet As Worksheet
    Set destinationSheet = ThisWorkbook.Worksheets("Sheet2")

    Dim sourceSheet As Worksheet
    Set sourceSheet = ThisWorkbook.Worksheets("Sheet1")

    Dim lastSourceRow As Long
    lastSourceRow = sourceSheet.Cells(sourceSheet.Rows.Count, "A").End(xlUp).Row

    Dim sourceRowIndex As Long

    Dim destinationRowIndex As Long
    destinationRowIndex = 1 ' Skip first row/headers

    Dim startDate As Variant
    Dim endDate As Variant
    Dim dateIndex As Date

    For sourceRowIndex = 2 To lastSourceRow ' Skip first row/headers.
        startDate = sourceSheet.Cells(sourceRowIndex, "B").Value
        endDate = sourceSheet.Cells(sourceRowIndex, "C").Value

        ' Validate dates before looping through them to prevent unwanted behaviour later
        If Not IsDate(startDate) Or Not IsDate(endDate) Then
            MsgBox ("Invalid date encountered in row '" & sourceRowIndex & "' of sheet '" & sourceSheet.Name & "'." & vbNewLine & vbNewLine & "Code will stop running now.")
            Application.Goto sourceSheet.Cells(sourceRowIndex, "B")
            Exit Sub
        ElseIf startDate > endDate Then
            MsgBox ("'Start date' exceed 'end date' on row '" & sourceRowIndex & "' of sheet '" & sourceSheet.Name & "'." & vbNewLine & vbNewLine & "Code will stop running now.")
            Application.Goto sourceSheet.Cells(sourceRowIndex, "B")
            Exit Sub
        End If

        For dateIndex = startDate To endDate
            destinationRowIndex = destinationRowIndex + 1

            destinationSheet.Cells(destinationRowIndex, "A").Value = sourceSheet.Cells(sourceRowIndex, "A").Value
            destinationSheet.Cells(destinationRowIndex, "B").Value = dateIndex

            dateIndex = Application.Min(Application.EoMonth(dateIndex, 0), endDate)
            destinationSheet.Cells(destinationRowIndex, "C").Value = dateIndex
        Next dateIndex

    Next sourceRowIndex

    destinationSheet.Range("D2:D" & destinationRowIndex).Formula = "=NETWORKDAYS(B2,C2)" 'Days worked
    destinationSheet.Range("E2:E" & destinationRowIndex).Formula = "=D2*15" ' Pay, same daily rate assumed for everyone (based on screenshot in question), but change as necessary

End Sub

您显然可以调整写入destinationSheet的公式，因为我已经做出了一些假设，这些假设可能并非每个“成员”都正确。

编辑：

NETWORKDAYS函数具有名为Holidays的第三个参数，您可以使用该参数指定要排除的日期。取决于您要如何实现。

方法1

例如，如果您将所有假期的日期存储在"Z1:Z5"上的"Sheet1"范围内，则可以在代码中更改此行：

destinationSheet.Range("D2:D" & destinationRowIndex).Formula = "=NETWORKDAYS(B2,C2)" 'Days worked

收件人：

destinationSheet.Range("D2:D" & destinationRowIndex).Formula = "=NETWORKDAYS(B2,C2,'Sheet1'!$Z$1:$Z$5)" 'Days worked

它会自动执行您需要的操作。

方法2

如果您想将它们存储在某些VBA变量中（而不是在工作表中），请尝试替换：

destinationSheet.Range("D2:D" & destinationRowIndex).Formula = "=NETWORKDAYS(B2,C2)" 'Days worked

具有：

Dim Holidays As Variant
Holidays = Array(#1/10/2019#, #1/28/2019#) ' Add as many dates as you need to. You can also add dates with DateSerial() function instead of literals, if needed.

destinationSheet.Range("D2:D" & destinationRowIndex).Formula = "=NETWORKDAYS(B1,C1,{" & holidaysToString(Holidays) & "})"

并将此函数与您的代码放在同一模块中

Private Function holidaysToString(ByVal Holidays As Variant) As String
    ' https://support.office.com/en-us/article/networkdays-function-48e717bf-a7a3-495f-969e-5005e3eb18e7 says to avoid putting dates as "text"
    '"Important:  Dates should be entered by using the DATE function, or as results of other formulas or functions. For example, use DATE(2012,5,23) for the 23rd day of May, 2012. Problems can occur if dates are entered as text."

    Dim index As Long
    For index = LBound(Holidays) To UBound(Holidays)
        Holidays(index) = CStr(CDbl(Holidays(index)))
    Next index
    holidaysToString = VBA.Strings.Join(Holidays, ",")
End Function

这将导致公式中数字的硬编码数组（代表假日）。

请确保还有其他方法来实现它，例如直接在For循环中进行计算，仅将返回值写入D列（而不是公式）。

在特定日期范围内，根据过去的月份生成新行

1 个答案: