Hallo zusammen,
ich möchte in der Spalte A nach zwei KWs Filtern (kw1 & kw2) und in Spalte C zählen, welche Nummern aus kw1 noch in kw2 vorhanden sind.
Es klappt alles in dem Code, nur bei der Duplikatsermittlung ist wohl irgendein Fehler. Ich würde mich über Hilfe freuen.
Sub filter_and_output_results()
' Declare variables
Dim kw1 As String
Dim kw2 As String
Dim num_common As Long
' Get input from user
kw1 = InputBox("Enter the last calendar week:")
kw2 = InputBox("Enter the current calendar week:")
' Filter columns A:C by kw1 and output the result in J2
Sheets("MASTER_DATA").Range("A:C").AutoFilter Field:=1, Criteria1:=kw1, VisibleDropDown:=False
Cells(2, 10).value = Application.WorksheetFunction.Subtotal(3, Range("A:A")) - 1
' Filter columns A:C by kw1 and output the result in K2
Sheets("MASTER_DATA").Range("A:C").AutoFilter Field:=1, Criteria1:=kw2, VisibleDropDown:=False
Cells(2, 11).value = Application.WorksheetFunction.Subtotal(3, Range("A:A")) - 1
' Calculate K2-J2 and output the result in N2
Cells(2, 14).value = Cells(2, 11).value - Cells(2, 10).value
' Filter columns A:C by kw1
ActiveSheet.Range("A:C").AutoFilter Field:=1, Criteria1:=kw1
' Loop through all rows in the sheet
For i = 1 To 3000
' Get the value in column C
value = Cells(i, 3).value
' Check if the value occurs in both kw1 and kw2
If Application.WorksheetFunction.CountIf(Range("A:A"), kw2) > 1 And Application.WorksheetFunction.CountIf(Range("C:C"), value) > 1 Then
' If it does, increment the count of common values
num_common = num_common + 1
End If
Next i
If ActiveSheet.AutoFilterMode Then
ActiveSheet.AutoFilterMode = False
End If
' Output the result and further calculations
Cells(2, 9).value = num_common / 2
Cells(2, 12).value = Cells(2, 10).value - Cells(2, 9).value
Cells(2, 13).value = Cells(2, 11).value - Cells(2, 9).value
End Sub
|