date在特定范围内时如何跳到下一个人？

我要计算每个工作人员的累计余额。 累计余额应按人计算。 有一些条件：

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

2）另外，如果每个人在“01/01/2016”和“31/03/2016”之间有任何logging，则不需要logging他/她的余额并转到下一个人。

这是示例。 S15在这个范围内没有logging，而最接近的“01/01/2016”是31.logging在S98之间。 因此，他的logging应该被忽略。

输出应该是：

• 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 

---

我想探测部分在这里。

它不能select该范围之间的date并跳到下一个人。

 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

编辑来sorting最终输出并删除其空白

我将使用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