Question

我有一个名为report的工作簿和一个名为kicker的工作簿。

在单元格B9的报表工作簿中，我有一个数字，在这种情况下是7。

该数字代表一周的数字。

我正在将我的跟踪器工作簿中的值复制到报告工作簿，其中该行包含数字7。

这是我的代码：

Option Explicit
Sub code3()
MsgBox "This will take upto 2 minutes."

Application.ScreenUpdating = False
Dim WB As Workbook
Dim I As Long
Dim j As Long
Dim Lastrow As Long
Dim WeekNum As Integer

'Clear Data Sheet

On Error GoTo Message

With ThisWorkbook.Worksheets("Data")
    .Rows(2 & ":" & .Rows.Count).ClearContents
End With

On Error Resume Next

Set WB = Workbooks("L.O. Lines Delivery Tracker.xlsm")
On Error GoTo 0
If WB Is Nothing Then 'open workbook if not open
    Set WB = Workbooks.Open("G:\WH DISPO\(3) PROMOTIONS\(18) L.O. Delivery Tracking\L.O. Lines Delivery Tracker.xlsm")
End If

' ======= Edit #2 , also for DEBUG ======
With WB.Worksheets(1)
    Lastrow = .Cells(.Rows.Count, "G").End(xlUp).Row

    j = 2

        For I = 7 To Lastrow

        WeekNum = CInt(Format(.Range("G" & I).Value, "ww", 2) - 1)

        ' === For DEBUG ONLY ===
        Debug.Print CInt(ThisWorkbook.Worksheets(2).Range("B9").Value)
        Debug.Print WeekNum
        Debug.Print CInt(ThisWorkbook.Worksheets(2).Range("D9").Value)
        Debug.Print Year(.Range("G" & I).Value)
        Debug.Print ThisWorkbook.Worksheets(2).Range("B6").Value
        Debug.Print .Range("M" & I).Value


        If CInt(ThisWorkbook.Worksheets(3).Range("B9").Value) = WeekNum Then ' check if Month equals the value in "A1"
            If CInt(ThisWorkbook.Worksheets(3).Range("D9").Value) = Year(.Range("G" & I).Value) Then ' check if Year equals the value in "A2"
            If ThisWorkbook.Worksheets(3).Range("B6").Value = .Range("M" & I).Value Then
                ThisWorkbook.Worksheets("Data").Range("A" & j).Value = .Range("G" & I).Value
                ThisWorkbook.Worksheets("Data").Range("B" & j).Formula = "=WeekNum(A" & j & ",21)"
                ThisWorkbook.Worksheets("Data").Range("C" & j).Value = .Range("L" & I).Value
                ThisWorkbook.Worksheets("Data").Range("D" & j).Value = .Range("D" & I).Value
                ThisWorkbook.Worksheets("Data").Range("E" & j).Value = .Range("E" & I).Value
                ThisWorkbook.Worksheets("Data").Range("F" & j).Value = .Range("F" & I).Value
                ThisWorkbook.Worksheets("Data").Range("g" & j).Value = .Range("p" & I).Value
                ThisWorkbook.Worksheets("Data").Range("H" & j).Value = .Range("H" & I).Value
                ThisWorkbook.Worksheets("Data").Range("I" & j).Value = .Range("I" & I).Value
                ThisWorkbook.Worksheets("Data").Range("J" & j).Value = .Range("J" & I).Value
                ThisWorkbook.Worksheets("Data").Range("k" & j).Value = .Range("Q" & I).Value
                ThisWorkbook.Worksheets("Data").Range("L" & j).Value = .Range("m" & I).Value
                ThisWorkbook.Worksheets("Data").Range("M" & j).Value = .Range("B" & I).Value


                Dim iVal As Integer
                Dim Lastrow2 As Long
                Lastrow2 = .Cells(Rows.Count, "D").End(xlUp).Row
                iVal = Application.WorksheetFunction.CountIf(Range("D" & Lastrow2), .Range("D" & I).Value)
                ThisWorkbook.Worksheets("Data").Range("N" & j).Value = iVal

                j = j + 1
            End If
            End If
        End If
    Next I

End With




Application.Calculation = xlAutomatic
ThisWorkbook.Worksheets("Data").UsedRange.Columns("B:B").Calculate
ThisWorkbook.Worksheets(3).UsedRange.Columns("B:AA").Calculate



On Error GoTo Message
With ThisWorkbook.Worksheets(3) '<--| change "mysheet" to your actual sheet name
    Intersect(.Range(Rows(14), .UsedRange.Rows(.UsedRange.Rows.Count)), .Range("G:G")).WrapText = True
    Intersect(.Range(Rows(14), .UsedRange.Rows(.UsedRange.Rows.Count)), .Range("G:G")).EntireRow.AutoFit
End With




End

ThisWorkbook.Worksheets(3).Activate
Application.ScreenUpdating = True

ThisWorkbook.Worksheets(3).EnableFormatConditionsCalculation


Exit Sub
Message:
On Error Resume Next
Exit Sub


End Sub

这是我的问题：

在复制过程中，我想在我的跟踪器工作簿中扫描D列以获取重复值。

我想要计算这些重复值出现的次数。

我正在尝试在我的代码的这一部分中执行此操作：

              Dim iVal As Integer
                Dim Lastrow2 As Long
                Lastrow2 = .Cells(Rows.Count, "D").End(xlUp).Row
                iVal = Application.WorksheetFunction.CountIf(Range("D" & Lastrow2), .Range("D" & I).Value)
                ThisWorkbook.Worksheets("Data").Range("N" & j).Value = iVal

由于某些原因它总是产生0，即使我的列中有重复值。

此外，我还想在此代码中添加一个条件，如果在B9中的周数的4周内（在我的报告工作簿中），则计算所有重复值。

因此，例如，如果报告在单元格B9中有周“7”，则计算第7周，第6周，第5周和第4周的所有重复值。

请有人帮助我使用我的代码，以便让它做我需要的吗？

Answer 1

你只对最后一行进行计数，所以你需要放置Range（“D7：

iVal = Application.WorksheetFunction.CountIf(Range("D7:D" & Lastrow2), .Range("D" & I).Value)

你真的需要Lastrow2吗？你不能用I-1代替

iVal = Application.WorksheetFunction.CountIf(Range("D7:D" & I-1), .Range("D" & I).Value)

此外，您可以在复制数据后使用D列上的条件格式以突出显示所有重复项。

Answer 2

因为你写了

我想在我的跟踪器工作簿中扫描D列以获取重复值

然后您想要在跟踪工作簿的相关表格中引用范围

所以你必须：

关注您的With WB.Worksheets(1)对象引用，方法是通过点（.）
使用CountIfs()功能并添加条件

所以改变：

iVal = Application.WorksheetFunction.CountIf(Range("D" & Lastrow2), .Range("D" & I).Value)

为：

iVal = Application.WorksheetFunction.CountIfs(.Range("D7:D" & Lastrow2), .Range("D" & I).Value, .Range("G7:G" & Lastrow2), WeekNum ) '<--| change "G" occurrences to actual weeknumber column index in `first` sheet of "Tracker" workbook

如果符合条件，VBA会计算值在列中出现的次数？

2 个答案: