Live-Forum - Die aktuellen Beiträge
Datum
Titel
29.03.2024 13:14:12
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
1100to1104
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

Doppelte Nennungen (Text/Zahl) Zählen

Doppelte Nennungen (Text/Zahl) Zählen
Lemmi
Hallo zusammen,
wie kann ich in ab Spalte H6 bis zum letzten Eintrag die Zelleninhalte vergleichen/ prüfen und Zählen.
Ich möchte ausgegeben bekommen die Anzahl der doppeleten/mehrfach Nennungen
Die Zellen beinhalten Zahlen oder Texte!
Nur wenn der ganze Inhalt in einer Zelle übereinstimmt wird gezählt (Leerzellen werden ignoriert)
z. B.
H6........ Auto
H7........123
H8........123
H9........ Auto
H10..... 123
H11...... Auto123
Ergebnis in : H3
Weil der Text Auto doppelt genannt wurde und weil 123 weitere 2 mal genannt wurde.
H11 wird nicht gewertet weil der Zelleninhalt ist werder mit dem Text noch mit der Zahl übereinstimmend!
Wird kein dopelter Eintrag gefunden so soll in der Zelle H3 stehen: "keine"
Gruß
Lemmi

6
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Benutzer
Anzeige
Beitrag.
18.09.2009 10:40:09
Lemmi
Hallo Tino,
Marko meldet einen Fehler :
Laufzeitfehler 424 in Zeile .Range("H4").Resize(Dic.Count, 1) = Application.Transpose(Dic.keys)
Was muss ich noch anpassen?
Sub doppelte_Zählen()
Dim Bereich As Range, meAr, Dic As Object
Dim A As Long
Set Dic = CreateObject("Scripting.Dictionary")
With Activsheet 'Sheets("Tabelle1") 'Tabellennamen anpassen
Set Bereich = Range("H6", Cells(Rows.Count, 6).End(xlUp))
meAr = Bereich
With Application.WorksheetFunction
For H = 1 To UBound(meAr)
If meAr(H, 1)  "" Then
If .CountIf(Bereich, meAr(H, 1)) > 1 Then
Dic(meAr(H, 1)) = 0
End If
End If
Next H
End With
.Range("H4").Resize(Dic.Count, 1) = Application.Transpose(Dic.keys)
End With
End Sub
GRuß
Lemmi
Anzeige
AW: Link zu einem Beitrag.
18.09.2009 10:40:55
Lemmi
Hallo Tino,
Marko meldet einen Fehler :
In einen Laufzeitfehler 424
in Zeile .Range("H4").Resize(Dic.Count, 1) = Application.Transpose(Dic.keys)
Was muss ich noch anpassen?
Sub doppelte_Zählen()
Dim Bereich As Range, meAr, Dic As Object
Dim A As Long
Set Dic = CreateObject("Scripting.Dictionary")
With Activsheet 'Sheets("Tabelle1") 'Tabellennamen anpassen
Set Bereich = Range("H6", Cells(Rows.Count, 6).End(xlUp))
meAr = Bereich
With Application.WorksheetFunction
For H = 1 To UBound(meAr)
If meAr(H, 1)  "" Then
If .CountIf(Bereich, meAr(H, 1)) > 1 Then
Dic(meAr(H, 1)) = 0
End If
End If
Next H
End With
.Range("H4").Resize(Dic.Count, 1) = Application.Transpose(Dic.keys)
End With
End Sub
GRuß
Lemmi
Anzeige
hier auf Deine Frage angepasst
18.09.2009 11:13:31
Tino
Hallo,
Du willst ja die doppelten und die Anzahl der doppelten.
Gesammelt wird in Tabelle1 ab H6
Das Ergebnis kommt in Tabelle2 ab A2 und B2.
Sub Beispiel()
   Dim Bereich As Range, meAr, Dic As Object
   Dim A As Long
   Dim sFormel As String
   
   Set Dic = CreateObject("Scripting.Dictionary")
   
       With Sheets("Tabelle1") 'Tabellennamen anpassen 
    
          Set Bereich = .Range("H6", .Cells(.Rows.Count, 8).End(xlUp))
          
          If Not Intersect(Bereich, .Rows("1:5")) Is Nothing Then
           MsgBox "keine Daten ab Zelle H6"
           Exit Sub
          End If
       
       End With
   
        meAr = Bereich
       'doppelte Sammeln ohne Duplikate 
       With Application.WorksheetFunction
           For A = 1 To Ubound(meAr)
             If meAr(A, 1) <> "" Then
                  If .CountIf(Bereich, meAr(A, 1)) > 1 Then
                   Dic(meAr(A, 1)) = 0
                  End If
             End If
           Next A
       End With
       
       'Ausgabe hier in Tabelle2 ab A2 
       With Sheets("Tabelle2").Range("A2") 'Ausgabe hier in Tabelle2 
         'leer machen für neue Daten 
         .Range("A2", .Cells(.Rows.Count, 2).End(xlUp).Offset(1, 0)).Value = ""
         'Werte einfügen 
         .Resize(Dic.Count, 1) = Application.Transpose(Dic.keys)
         'Formel für die Anzahl erstellen 
         sFormel = "=COUNTIF(" & Bereich.Address(ReferenceStyle:=xlR1C1, External:=True) & ",RC[-1])"
         .Offset(0, 1).Resize(Dic.Count, 1).FormulaR1C1 = sFormel
       End With

End Sub
Gruß Tino
Anzeige
AW: hier auf Deine Frage angepasst
18.09.2009 11:33:31
Lemmi
Hallo Tino,
passt wackelt und hat Luft! Super!
Vielen Dank!
Gruß
Lemmi
wackeln sollte es nicht, danke f. Rückm. oT.
18.09.2009 11:34:50
Tino

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige