Thema Datum  Von Nutzer Rating
Antwort
Rot VBA - Duplikate suchen und ausgeben
04.01.2023 15:23:04 Patrick
NotSolved

Ansicht des Beitrags:
Von:
Patrick
Datum:
04.01.2023 15:23:04
Views:
115
Rating: Antwort:
  Ja
Thema:
VBA - Duplikate suchen und ausgeben

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

 


Ihre Antwort
  • Bitte beschreiben Sie Ihr Problem möglichst ausführlich. (Wichtige Info z.B.: Office Version, Betriebssystem, Wo genau kommen Sie nicht weiter)
  • Bitte helfen Sie ebenfalls wenn Ihnen geholfen werden konnte und markieren Sie Ihre Anfrage als erledigt (Klick auf Häckchen)
  • Bei Crossposting, entsprechende Links auf andere Forenbeiträge beifügen / nachtragen
  • Codeschnipsel am besten über den Code-Button im Text-Editor einfügen
  • Die Angabe der Emailadresse ist freiwillig und wird nur verwendet, um Sie bei Antworten auf Ihren Beitrag zu benachrichtigen
Thema: Name: Email:

 
 

  • Bitte beschreiben Sie Ihr Problem möglichst ausführlich. (Wichtige Info z.B.: Office Version, Betriebssystem, Wo genau kommen Sie nicht weiter)
  • Bitte helfen Sie ebenfalls wenn Ihnen geholfen werden konnte und markieren Sie Ihre Anfrage als erledigt (Klick auf Häckchen)
  • Bei Crossposting, entsprechende Links auf andere Forenbeiträge beifügen / nachtragen
  • Codeschnipsel am besten über den Code-Button im Text-Editor einfügen
  • Die Angabe der Emailadresse ist freiwillig und wird nur verwendet, um Sie bei Antworten auf Ihren Beitrag zu benachrichtigen

Thema Datum  Von Nutzer Rating
Antwort
Rot VBA - Duplikate suchen und ausgeben
04.01.2023 15:23:04 Patrick
NotSolved