0
我有一個名爲報告的工作簿和一個名爲tacker的工作簿。如果滿足條件，VBA會計算colum中出現值的次數？
在我的報告單元格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
請有人可以幫助我與我的代碼，以讓它做我需要的嗎？
感謝您的建議，但這似乎沒有任何區別。 – user7415328
您的countif只檢查最後一行的範圍。我已經更新了我的答案。 – Gordon
忽略我有關添加到iVal變量的答案，我可以看到您將值放入每個循環的不同單元格中。 – Gordon