Office: (Office 2016) Duplikate entfernen, Zellen zählen, Werte hinzufügen

Helfe beim Thema Duplikate entfernen, Zellen zählen, Werte hinzufügen in Microsoft Excel Hilfe um das Problem gemeinsam zu lösen; Hallo Leute, ich arbeite aktuell noch händisch mit meinen Werten und wollte das ganze per VBA umsetzen. Leider ist das ganze ein bisschen kompliziert.... Dieses Thema im Forum "Microsoft Excel Hilfe" wurde erstellt von Creator-X, 20. September 2022.

  1. Duplikate entfernen, Zellen zählen, Werte hinzufügen


    Hallo Leute,
    ich arbeite aktuell noch händisch mit meinen Werten und wollte das ganze per VBA umsetzen.
    Leider ist das ganze ein bisschen kompliziert.
    Ich habe mal eine TB angehangen wo ich auf TB1 in Spalte A Meine Werte habe so wie ich Sie auslese aus ein Gerät. In Spalte C hab ich die Werte stehen so wie es dann nach der händischen Bearbeitung aussieht.
    Problem: Ich will zählen wieviel mal ich SW, MN, AN vorhanden habe ohne Duplikate. Und das sollte dann in der Oberen Zelle mit hinzugefügt werden. Wobei die Duplikate angezeigt bleiben sollen.
    Wenn jemand so etwas öder Ähnliches gemacht hat wäre ich dankbar für mögliche Lösungsansätze.
    Gruß CX
     
    Creator-X, 20. September 2022
    #1
  2. OilMax hat Ahnung
    Hallo,

    teste mal
    Code:
    Option Explicit
    
    Sub Sortieren()
        Dim arrIn(), arrName(), varDoppel$, i&, j&, k&, l%
        With Tabelle1
            arrIn = .Range("A2:A114").Value
        End With
        k = 1
        For i = 1 To UBound(arrIn)
            If Not InStr(1, arrIn(i, 1), "SW") > 0 Then
                If Not InStr(1, varDoppel, arrIn(i, 1)) > 0 Then
                    ReDim Preserve arrName(1 To k)
                    arrName(k) = arrIn(i, 1)
                    k = k + 1
                    varDoppel = varDoppel & arrIn(i, 1) & "~~"
                 End If
            Else
                ReDim Preserve arrName(1 To k)
                    arrName(k) = arrIn(i, 1)
                    k = k + 1
            End If
        Next i
        For i = 2 To UBound(arrName)
            Tabelle1.Cells(i, 5) = arrName(i - 1)
        Next i
    End Sub
    Gruß Uwe
     
  3. Hallo Uwe,
    ah ja, so in die Richtung. Irgendwie nimmt er bei mir die letzte Zeile nicht mit.Duplikate entfernen, Zellen zählen, Werte hinzufügen :( Hab den Code genauso eingefügt.
     
    Creator-X, 20. September 2022
    #3
  4. Exl121150 Erfahrener User

    Duplikate entfernen, Zellen zählen, Werte hinzufügen

    Hallo,

    ich war mir nicht sicher, ob ich dich richtig verstanden habe. Ich habe dir im allgem.Codemodul eine benutzerdef. Funktion "ZaehlenEindeutig(Bereich;Kriterium)" eingefügt. Sie ist im Folgenden aufgelistet:
    Code:
    Public Function ZaehlenEindeutig(rngBereich As Range, Krit As String) As Long
       Dim KritCol As New Collection, ItemCol As Variant, IstInCol As Boolean
       Dim rngZelle As Range, strWert As String
      
       For Each rngZelle In rngBereich.Cells
           strWert = rngZelle.Value
           If Right(strWert, Len(Krit)) = Krit Then
              IstInCol = False
              For Each ItemCol In KritCol
                 If ItemCol = strWert Then
                    IstInCol = True: Exit For
                 End If
              Next ItemCol
              If Not IstInCol Then
                 KritCol.Add Item:=strWert
              End If
           End If
       Next rngZelle
      
       ZaehlenEindeutig = KritCol.Count
       Set KritCol = Nothing
    End Function
    

    Sie gibt die Anzahl der gefundenen eindeutigen Zeichenketten zuück, sofern diese Zeichenketten an ihrem Ende mit dem Filterkriterium übereinstimmen.

    In Zelle D1 habe ich dir damit folgende Formel eingefügt, die diese Funktion 3x verwendet:
    ="("&ZaehlenEindeutig(C2:C87;"SW")&" SW)(" & ZaehlenEindeutig(C2:C87;"MN")&" MN)("&ZaehlenEindeutig(C2:C87;"AN")&" AN)"
    Das Ergebnis dieser Formel in D1 ist: (17 SW)(1 MN)(1 AN)
     
    Exl121150, 20. September 2022
    #4
  5. OilMax hat Ahnung
    Hallo,
    ja, da hat einfach nur ein +1 gefehlt.
    Code:
    Option Explicit
    
    Sub Sortieren()
        Dim arrIn(), arrName(), varDoppel$, i&, j&, k&, l%
        With Tabelle1
            arrIn = .Range("A2:A" & .Cells(Rows.Count, 1).End(xlUp).Row).Value
        End With
        k = 1
        For i = 1 To UBound(arrIn)
            If Not InStr(1, arrIn(i, 1), "SW") > 0 Then
                If Not InStr(1, varDoppel, arrIn(i, 1)) > 0 Then
                    ReDim Preserve arrName(1 To k)
                    arrName(k) = arrIn(i, 1)
                    k = k + 1
                    varDoppel = varDoppel & arrIn(i, 1) & "~~"
                 End If
            Else
                ReDim Preserve arrName(1 To k)
                    arrName(k) = arrIn(i, 1)
                    k = k + 1
            End If
        Next i
        For i = 2 To UBound(arrName) + 1
            Tabelle1.Cells(i, 5) = arrName(i - 1)
        Next i
    End Sub
     
  6. Hallo Exl121150,
    danke, ja das schaut ja mal echt krass aus. Leider habe ich mit "Public Function" noch nichts gemacht und kann es leider nicht starten oder aufrufen.
    ich hab es jetzt mal probiert über ein "Sub xxxx()" aufzurufen aber es funktioniert bei mir nichtDuplikate entfernen, Zellen zählen, Werte hinzufügen :confused:
     
    Zuletzt bearbeitet: 20. September 2022
    Creator-X, 20. September 2022
    #6
  7. Exl121150 Erfahrener User
    Hallo,

    eine "Function" in VBA verhält sich wie eine Arbeitsblattfunktion. Wenn/Falls du meine Formel im Arbeitsblatt in Zelle D1 angeschaut hast, siehst du, dass ich sie dort 3x eingesetzt habe.
    Die Funktion benötigt 2 Parameter: Der 1.Parameter ist der Zellbereich mit den zu untersuchenden Zeichenketten, der 2. Parameter ist die Zeichenkette, die das Abfragekriterium enthält.

    Gibst du also zB. in Zelle E1 folgende Formel ein: =ZaehlenEindeutig(C2:C87;"SW")
    greift die Funktion
    1) auf den Zellbereich C2:C87 zu,
    2) filtert die darin enthaltenen Zeichenketten, indem sie "SW" mit dem Ende jeder dort enthalten Zeichenkette vergleicht,
    3) aus der Menge der verbleibenden, zutreffenden Zeichenketten werden nur die eindeutigen Zeichenketten herausgeholt (ohne Duplikate)
    4) und schließlich wird die Anzahl dieser Zeichenketten ermittelt, wenn man die Duplikate nicht mit berücksichtigt.
    5) Diese so ermittelte Anzahl beträgt für die Filterzeichenkette "SW" genau 17.

    Die Funktion, die ich dir in Zelle D1 eingefügt habe, überprüft 3x den Zellbereich C2:C87 und ermittelt die Anzahlen der 3 Filterzeichenketten "SW", "MN", "AN", wobei sich ergibt (in gleicher Reihenfolge): 17, 1, 1

    Da ich deine geschilderten Anforderungen nicht klar enträtseln konnte, nahm ich an, dass du die soeben beschriebene Funktion wünschst. Wenn du aber haben möchtest, dass der Zellbereich C2:C87 in irgendeiner Weise verändert werden soll, dann müsstest du mir dies entsprechend deutlicher mitteilen.
     
    Exl121150, 21. September 2022
    #7
  8. Duplikate entfernen, Zellen zählen, Werte hinzufügen

    Hi Exl121150,
    ok jetzt hab ich verstanden. Denk ich. Aber kann man diese Funktion nicht rein Als VBA Code machen? Ich habe vor das ganze als Addin zu speichern und dann immer nur auf die jeweilige Datei anzuwenden. Das würde ja dann nicht gehn wenn ich immer die Formel in der Celle dazu brauche. Duplikate entfernen, Zellen zählen, Werte hinzufügen o_O
    Oder ich lass die Formel per VBA Code in die Celle reinschreiben.Duplikate entfernen, Zellen zählen, Werte hinzufügen :rolleyes:
     
    Creator-X, 21. September 2022
    #8
  9. Exl121150 Erfahrener User
    Hallo,
    genau genommen ist auch die Funktion nichts anderes als VBA-Code (=Visual BASIC for Applications)
    In der beiliegenden Datei habe ich dir zusätzlich zur vorgenannten Funktion noch die beiden folgenden SUBs eingefügt:
    Code:
    Public Sub ZaehlenEindeutig_mit_FixBereichSW()
       Selection.Formula = "=ZaehlenEindeutig(C2:C87,""SW"")"
    End Sub
    Public Sub ZaehlenEindeutig_mit_BereichKrit()
       Dim strBereich As String, strKrit As String
       With Selection
         strBereich = .Offset(0, -2).Value
         strKrit = .Offset(0, -1).Value
         .Formula = "=ZaehlenEindeutig(" & strBereich & ",""" & strKrit & """)"
       End With
    End Sub
    
    Diese beiden SUBs habe ich mit je einem Button im Arbeitsblatt verknüpft.
    Wie diese beiden Buttons zu verwenden sind, habe ich dir ins Arbeitsblatt als Kommentar geschrieben.
     
    Exl121150, 22. September 2022
    #9
  10. So funktioniert es schon mal im Sheet mit der Formel.
    Code:
    ="Pos. " & ZaehlenEindeutig(C3:C88;"MN")+ZaehlenEindeutig(C3:C88;"AN")+ZaehlenEindeutig(C3:C88;"SW")&" SW"
    Das heist ich müste es nur noch hier einfügen und auf die Zelle C1 beziehen
    Code:
    Public Sub ZaehlenEindeutig_mit_FixBereichSW()
       Selection.Formula = "=ZaehlenEindeutig(C2:C87,""SW"")"
    End Sub
    Oder?
     
    Creator-X, 22. September 2022
    #10
  11.  
    Creator-X, 22. September 2022
    #11
  12. Exl121150 Erfahrener User
    Hallo,

    wie du siehst, wird der Formula-Eigenschaft von "Selection" die Formel zugewiesen. Dabei bedeutet "Selection", diejenige Zelle, die markiert ist bzw. die die aktive Zelle ist, d.h. diejenige Zelle, in die du als nächstes einen Wert eingeben könntest. Wenn die Zelle C1 die aktive (=markierte) Zelle ist, dann brauchst du nur auf den Button "ZählenEindeutig mit festem Bereich und Kriterium" und die Formel =ZaehlenEindeutig(C2:C87,"SW") wird der Zelle zugewiesen, womit Excel in die Lage versetzt wird, die Formel zu berechnen. Geht man von den vorliegenden Beispieldaten aus, erhältst du als Resultat die Zahl 17.
    Steht in der Zelle C1 bereits eine Formel, bevor du auf den Button klickst, so wird natürlich die ursprüngliche Formel durch das Button-Klicken mit der vorgenannten Formel ersetzt.
     
    Exl121150, 23. September 2022
    #12
  13. Duplikate entfernen, Zellen zählen, Werte hinzufügen

    Hi,

    also wenn ich den Code so einfüge dann funktioniert es. Nur das ich noch ein paar " zuviel drinnen habe und die nicht wegbekomme.Duplikate entfernen, Zellen zählen, Werte hinzufügen o_O
    Code:
    Public Function ZaehlenEindeutig(rngBereich As Range, Krit As String) As Long
       Dim KritCol As New Collection, ItemCol As Variant, IstInCol As Boolean
       Dim rngZelle As Range, strWert As String
      
       For Each rngZelle In rngBereich.Cells
           strWert = rngZelle.Value
           If Right(strWert, Len(Krit)) = Krit Then
              IstInCol = False
              For Each ItemCol In KritCol
                 If ItemCol = strWert Then
                    IstInCol = True: Exit For
                 End If
              Next ItemCol
              If Not IstInCol Then
                 KritCol.Add Item:=strWert
              End If
           End If
       Next rngZelle
      
       ZaehlenEindeutig = KritCol.Count
       Set KritCol = Nothing
    End Function
    Sub SW_Zählen()
    
    Range("C1").Value = "=""Pos.""""(""&ZaehlenEindeutig(R[1]C:R[87]C,""MN"")+ZaehlenEindeutig(R[1]C:R[87]C,""AN"")+ZaehlenEindeutig(R[1]C:R[87]C,""SW"")&"" SW)"""
    
    End Sub
     
    Creator-X, 24. September 2022
    #13
  14.  
    Creator-X, 24. September 2022
    #14
  15. Exl121150 Erfahrener User
    Hallo,
    ich habe dir 2 SUBs gebastelt. Es folgt die erste SUB. Sie stellt einen Wert in Zelle C1:
    Code:
    Sub Wert_In_C1()
       Dim Ct As Long
       Ct = ZaehlenEindeutig(Range("C2:C87"), "MN") + ZaehlenEindeutig(Range("C2:C87"), "AN") + ZaehlenEindeutig(Range("C2:C87"), "SW")
       Range("C1").Value = "Pos.(" & Ct & ") SW"
      
    End Sub
    

    Und hier ist die zweite SUB. Sie fügt in Zelle C1 eine Formel ein. Sie enthält gleichzeitig auch einen Kommentar, der die Problematik beschreibt:
    Code:
    Sub Formel_In_C1()
      
    '1) Folgende Formel soll in C1 gespeichert werden:
    '
    '        ="Pos.(" & ZaehlenEindeutig(C2:C87,"SW")+ZaehlenEindeutig(C2:C87,"AN")+ZaehlenEindeutig(C2:C87,"SW") & ") SW"
    '
    '2) Da diese Formel ihrerseits in einer Zeichenkette gespeichert werden soll/muss,
    '      muss jedes enthaltene Anführungszeichen durch 2 Anführungszeichen ersetzt werden.
    '3) Da die Formel in Range("C1") gespeichert werden soll mit Hilfe der Eigenschaft ".FormulaR1C1",
    '      müssen die enthaltenen Bereichsadressen in relative Adressen bezüglich C1 umgewandelt werden:
    
        Range("C1").Formula2R1C1 = "=""Pos.("" & ZaehlenEindeutig(R[1]C:R[86]C,""SW"")+ZaehlenEindeutig(R[1]C:R[86]C,""AN"")+ZaehlenEindeutig(R[1]C:R[86]C,""SW"") & "") SW"""
      
    End Sub
    
     
    Exl121150, 26. September 2022
    #15
Thema:

Duplikate entfernen, Zellen zählen, Werte hinzufügen

Die Seite wird geladen...
  1. Duplikate entfernen, Zellen zählen, Werte hinzufügen - Similar Threads - Duplikate entfernen Zellen

  2. Entfernen von Duplikaten (Power Query)

    in Microsoft Excel Tutorials
    Entfernen von Duplikaten (Power Query): Entfernen von Duplikaten (Power Query) Excel für Microsoft 365 Excel 2019 Excel 2016 Excel 2013 Excel 2010 Mehr... Weniger...
  3. Befehl "Duplikate entfernen" funktioniert nicht!?

    in Microsoft Excel Hilfe
    Befehl "Duplikate entfernen" funktioniert nicht!?: Hallo zusammen, vielleicht versteht jemand von euch, was das hier soll? Ich habe eine Beispieldatei angehängt. Ganz offensichtlich sind die Daten in den ersten beiden Zeilen identisch, werden von...
  4. Löschabfrage -> nur ein Duplikat entfernen

    in Microsoft Access Hilfe
    Löschabfrage -> nur ein Duplikat entfernen: Hallo zusammen, ich habe eine Löschabfrage erstellt, allerdings werden dabei alle Duplikate entfernt: DELETE IN_V5.IDAlex FROM IN_V5 WHERE IDAlex IN (SELECT IDAlex FROM IN_V5 GROUP BY...
  5. VBA Tabelle Filtern und neue Arbeitsblätter

    in Microsoft Excel Hilfe
    VBA Tabelle Filtern und neue Arbeitsblätter: Hallo, ich will über VBA Zellen auswählen und diese Filtern (Duplikate entfernen) Habe Tabelle mit Spalte A (verantwortlicher Trainer) und in Spalte B den Gruppennamen usw. Danach soll für...
  6. Outlook 2013 – Duplikate entfernen

    in Microsoft Outlook Hilfe
    Outlook 2013 – Duplikate entfernen: Hallo liebe Forenuser, ich habe ein Problem. Durch verschiedene Import/Export Fehler liegen ein paar tausend doppelte E-Mail in verschiedenen Konten. Kennt zufällig jemand ein kostenloses Tool...
  7. Duplikate entfernen ungeachtet der Wortreihenfolge

    in Microsoft Excel Hilfe
    Duplikate entfernen ungeachtet der Wortreihenfolge: Hallo, Ich möchte in Excel gerne Duplikate entfernen, die Wortreihenfolge soll dabei aber nicht beachtet werden. Beispiel: „auto kaufen“ und „kaufen auto“ sollen als Duplikate erkannt und...
  8. Duplikate spaltenweise entfernen

    in Microsoft Excel Hilfe
    Duplikate spaltenweise entfernen: Hallo zusammen, ich habe ein Problem, was vermutlich einfach zu lösen ist, aber ich komme nicht auf die Lösung. Ich habe eine große Tabelle mit vielen Zeilen und Spalten. In manchen Spalten...
  1. Diese Seite verwendet Cookies, um Inhalte zu personalisieren, diese deiner Erfahrung anzupassen und dich nach der Registrierung angemeldet zu halten.
    Auf dieser Website werden Cookies für die Zugriffsanalyse und Anzeigenmessung verwendet.
    Wenn du dich weiterhin auf dieser Seite aufhältst, akzeptierst du unseren Einsatz von Cookies.
    Information ausblenden