Question

我将计算每位员工的累积余额。累计余额应按人数计算。有一些条件：

1）累计余额应仅在“01/01/2016”之前计算，最接近“01/01/2016”。

2）此外，如果每个人在“01/01/2016”和“31/03/2016”之间有任何记录，则无需再记录他/她的余额并转移到下一个人。

以下是样本。 S15在该范围与“01/01/2016”之间最接近的余额之间没有记录.S98在该范围之间有记录。因此，他的记录应该被忽略。

输出应为：

S15 31

我的代码在这里：

Sub gg()

    Dim startdate As Date
    Dim curr, neww As Long
    Dim i As Integer
    Dim j As Integer
    Dim closest As Integer
    Dim range As Long
    Dim ws As Worksheet
    Set ws = worksheet1
    With ws
        Dim enddate As Date

        i = 2
        j = 2
        startdate = "01/01/2016"
        enddate = "31/03/2016"
        closest = 2

        range = enddate - startdate
        Do While .Cells(i, 2) <> 0
            If (.Cells(i, 2) >= startdate Or .Cells(i, 2) <= enddate) Then

                Do While .Cells(i + 1, 1) = .Cells(i, 1)
                    i = i + 1
                Loop
                i = i + 1
            End If
            '''
            curr = .Cells(i, 2) - startdate
            ''
            If (.Cells(i, 2) - startdate) <= curr Then
                neww = (.Cells(i, 2) - startdate)
                closest = closest + 1
            End If
            If (.Cells(i + 1, 1)) <> .Cells(i, 1) Then
                .Cells(j, 5) = .Cells(i, 1)
                .Cells(j, 6) = .Cells(closest, 3)
                curr = .Cells(i + 1, 2) - startdate

                j = j + 1
            End If

            i = i + 1
        Loop
    End With

End Sub

我猜探索部分就在这里。

无法选择该范围之间的日期并跳至下一个人。

If (.Cells(i, 2) >= startdate Or .Cells(i, 2) <= enddate) Then

    Do While .Cells(i + 1, 1) = .Cells(i, 1)
        i = i + 1
    Loop
    i = i + 1
End If

Answer 1

已修改以对最终输出进行排序并删除其空白

我使用Range对象的RemoveDuplicates()和AutoFilter()方法，如下所示（请参阅评论）：

Option Explicit

Sub main()
    Dim cell As range

    With Worksheets("balance") '<--| change name with your actual worksheet name
        With .range("A1", .Cells(.Rows.Count, "C").End(xlUp)) '<--| consider your actual data: form cell "A1" down to last non empty cell of column "C"
            With .Resize(, .Columns.Count + 2) '<--| consider the range expanded rightwards two columns from the last one
                With .Columns(.Columns.Count) '<--| consider "new" last column
                    .value = .Parent.Columns(1).value '<--| copy StaffID values from column "A"
                    .RemoveDuplicates Columns:=Array(1), header:=xlYes '<--| remove StaffID duplicates
                    .Offset(, 1).Resize(1) = "Balance" '<-- add header "Balance" in one column left first row
                End With
                For Each cell In .Columns(.Columns.Count).Offset(1).Resize(.Rows.Count - 1).SpecialCells(xlCellTypeConstants) '<--| loop through unique values
                    .AutoFilter field:=1, Criteria1:=cell.value '<--| filter column "A" (StaffID) with values corresponding to current unique StaffID value
                    .AutoFilter field:=2, Criteria1:="<01/03/2016" '<--| filter column "B" (dates) with dates preceeding "1/3/2016" only
                    If Application.WorksheetFunction.Subtotal(103, .Cells.Resize(, 1)) > 1 Then '<--| if any cell has been filtered...
                        With .Columns(2).SpecialCells(xlCellTypeVisible) '<--| ... consider column "B" (dates) filtered cells...
                            cell.Offset(, 1) = GetMaxDate(.Cells, Application.WorksheetFunction.Max(.Cells)) '...and get the balance corresponding to highest visible date and store next to StaffID unique value
                       End With
                    Else '<--| otherwise...
                        cell.ClearContents '<--|... clear "invalid" StaffID unique value
                    End If
                    .AutoFilter '<--| show all rows back...
                Next cell
                With .Columns(.Columns.Count) '<--| consider "new" last column
                    range(.range("A1"), .Cells(.Rows.Count, 2).End(xlUp)).Sort key1:=.range("A1"), header:=xlYes '<--| sort it by its first column ('StaffID') and remove blanks
                End With
            End With
        End With
    End With
End Sub

Function GetMaxDate(rng As range, dt As Date) As Double
    Dim cell As range
    For Each cell In rng
        If cell.value = dt Then Exit For
    Next cell
    GetMaxDate = cell.Offset(, 1).value
End Function

如果日期在特定范围内，如何跳到下一个人？

1 个答案: