VBA Excel恢复重复计数，而在重新启动计数后不更改以前的重复计数

Question

我已经被这个问题困扰了好几个星期了。

1. 我有一个代码，该代码将计算重复次数并同时重新开始计数 工作日= 1（星期一）的时间

2. 工作日值在第2列工作表B9列中

3. I列显示重复计数值（1,2,3,4,5）

4. 第Q列说明该值重复

我的问题是如何更改代码，以便它将在第2、3、4和5天恢复重复计数，而不会在上周更改重复计数：-

1. 因此，假设上周重复计数是工作日1 = 1，工作日2 = 2，工作日 3 = 3，所以本周如果还有2个重复项。

2. 本周将计为1，2 不 继续重复计数 从上周开始为4、5。

3. 我认为它需要绑定到列Q，所以当它不为空时，它不会  更改以前的重复计数？

下面是代码：-

Sub restart() 'TO restart on monday

Dim LastR As Range, x As Long

If IsEmpty([h5]) Then Exit Sub
Set LastR = [i5]
If Not IsEmpty(LastR) Then Set LastR = Range("i" & Rows.Count).End(xlUp)(2)
x = Range("h" & Rows.Count).End(xlUp).Row
If x < LastR.Row Then Exit Sub
If Sheet2.Range("B9").Value = 1 Then 'when weekday =1
With Range(LastR, Range("i" & x))
    .Formula = "=mod(countif(h$" & .Row & ":h" & .Row & ",h" & .Row & "),5)+" & _
            "if(mod(countif(h$" & .Row & ":h" & .Row & ",h" & .Row & "),5)=0,5,0)"
    .Value = .Value
End With
End If

End Sub

Desired Output image

Answer 1

所以我做了什么：

• 单元格B2的公式为=COUNTIFS(A:A,A2,D:D,"<"&D2,E:E,E2)+1
• 单元格C2的公式为="Weekday "&WEEKDAY(D2,2)
• 单元格E2的公式为="WEEK "&WEEKNUM(D2,2)
• 单元格F2的公式为=IF(B2>1,"Duplicate,"")
• 向下拖动公式

在场外，您需要根据数据引用列。

要在将一些新数据添加到列表时自动放入公式，可以采用多种方法，但一种简单的方法可能是：

Private Sub Worksheet_Change(ByVal Target As Range)
Application.EnableEvents = False
Application.ScreenUpdating = False
Application.Calculation = xlManual

Dim X As Long, LR As Long
With ActiveSheet
    LR = .Cells(.Rows.Count, "A").End(xlUp).Row
End With
For X = 2 To LR
    If Cells(X, 2) = "" Then
        Cells(X, 2).Formula = "=COUNTIFS(A:A,A" & X & ",D:D,""< ""&D" & X & ",E:E,E" & X & ")+1"
        Cells(X, 3).Formula = "=""Weekday ""&WEEKDAY(D" & X & ",2)"
        Cells(X, 4).Value = Date
        Cells(X, 5).Formula = "=""Week ""&WEEKNUM(D" & X & ",2)"
        Cells(X, 6).Formula = "=IF(B" & X & ">1,""Duplicate"","""")"
    End If
Next X

Application.EnableEvents = True
Application.ScreenUpdating = True
Calculate
End Sub

将此宏粘贴到您正在使用的工作表下。再次，将列号的引用更改为您自己的引用。