Live-Forum - Die aktuellen Beiträge
Datum
Titel
20.04.2024 00:49:19
Excel Sheet in einen Excel Kalender einfügen
20.04.2024 00:08:11
In Ordner nur das Speichern von Dateien erlauben
19.04.2024 21:26:15
mehrfache Texte finden
19.04.2024 19:41:34
Bei VBA Ausführung Anzeige einfrieren
Du findest keine passende Antwort auf Deine Frage?
Stelle Deine Frage in unserem Live-Forum
Anzeige
Archiv - Navigation
1124to1128
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
Vorheriger Thread
Vorheriger Thread
Rückwärts Blättern
1124to1128
1124to1128
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Nächster Thread
Nächster Thread
Vorwärts blättern
Inhaltsverzeichnis

Help! Zählenwen

Help! Zählenwen
Claudia
Hallo zusammen,
ich habe eine Tabelle mit mehreren tausend Datensätzen (beginnend ab Zeile 2)
Spalte A = Kundenummer
Spalte B = ID-Nr.
Spalte C = ID-Name
Die ID-Nr- und der ID-Name kommen mehrfach in der Tabelle vor. Jetzt soll ich alle ID-Namen zählen und in einer zweiten Tabelle darstellen (also zählenwenn...).
Ich habe mir das schon sortiert, aber bei ca. 4000 Einträgen bin ich vermutlich Ewigkeiten unterwegs. Hat jemand zufällig eine VBA-Lösung für mich?
Vielen lieben Dank!
LG
Claudia
mit Spezialfilter und Anzahl2()
28.12.2009 13:50:16
Matthias
Hallo Claudia
Userbild
Gruß Matthias
AW: mit Spezialfilter und Anzahl2()
28.12.2009 13:57:51
Claudia
Hallo Matthias,
diese Funktion kann ich noch gar nicht. Habe wieder was dazugelernt. Danke!
In diesem Fall brauche ich aber die Anzahl, wie häufig ein ID-Name vorkommt. Gibt es da auch eine
Funktion? Und das halt für jeden ID-Name, der vorkommt.
LG
CLaudia
AW: mit Spezialfilter und Anzahl2()
28.12.2009 13:59:48
Reinhard
Hallo Claudia,
wenn ich Recht verstehe, Zählenwenn()
Gruß
Reinhard
AW: mit Spezialfilter und Anzahl2()
28.12.2009 14:05:30
Claudia
Hallo Reinhard,
ja aber bei über 4000 Einträgen eine mühsame Arbeit. Daher meine Frage nach einer VBA-Lösung oder einem Spezialfilter, die ich nicht kenne.
LG
Claudia
Anzeige
AW: mit Spezialfilter und Anzahl2()
28.12.2009 14:15:59
tommy
Mein Tipp: 

Sub Filtern()
Dim i1 As Integer, i2 As Integer
Application.ScreenUpdating = False
Sheets("Datensatz").Copy After:=Sheets("Datensatz") 'kopiert erstmal den Datensatz in neues  _
Sheet
i1 = Cells(Cells.Rows.Count, 2).End(xlUp).Row
For i2 = i1 To 1 Step -1
If WorksheetFunction.CountIf(Columns(2), Cells(i2, 2)) > 1 Then 'doppelte Id-Nr.Prüfen  _
und Zeile löschen
Rows(i2).Delete
End If
Next i2
End Sub

Dann nur Anzahl Zellen zählen
Anzeige
Du brauchst doch nur noch zu zählen
28.12.2009 14:27:22
Matthias
Hallo
Nach dem Setzen des Spezialfilters brauchst Du doch nur noch die Formel Zählenwenn() einzusetzen
Userbild
Jetzt nur noch Deine beiden Spalten kopieren und in Tab2 als Werte einfügen- Fertig.
Gruß Matthias
hier mal eine VBA Variante
28.12.2009 14:08:09
Tino
Hallo,
Sub Beispiel()
Dim oDic As Object, meAr()
Dim A As Long, sFormel$

Set oDic = CreateObject("Scripting.Dictionary")
'Tabelle anpassen 
With Sheets("Tabelle1")
 'Bereich anpassen, hier ohne Überschrift 
 meAr = .Range("C2", .Cells(.Rows.Count, 3).End(xlUp)).Value2
 'Formel erstellen für die Zählung 
 sFormel$ = "=COUNTIF('" & .Name & "'!C3,RC1)"
End With

For A = 1 To Ubound(meAr)
  oDic(meAr(A, 1)) = 0
Next

With Sheets("Tabelle2")
    'Überschrift 
    .Cells(1, 1) = "ID-Name"
    .Cells(1, 2) = "Anzahl"
    .Range("A1:B1").Font.Bold = True
    'Bereich leer machen 
    .Cells(2, 1).Resize(.Cells(.Rows.Count, 1).End(xlUp).Row + 1, 2).ClearContents
    'Daten in Spalte 1 schreiben 
    .Cells(2, 1).Resize(oDic.Count) = Application.Transpose(oDic.keys)
    With .Cells(2, 2).Resize(oDic.Count)
        'Formel in Spalte 2 schreiben 
        .FormulaR1C1 = sFormel
        'Formel durch Werte ersetzen 
        .Value = .Value
    End With
End With


End Sub
Gruß Tino
Anzeige
hier noch Version ohne Formel...
28.12.2009 14:48:00
Tino
Hallo,
Sub Beispiel()
Dim oDic As Object, meAr()
Dim A As Long, sFormel$

Set oDic = CreateObject("Scripting.Dictionary")

'Tabelle anpassen 
With Sheets("Tabelle1")
 'Bereich anpassen, hier ohne Überschrift 
 meAr = .Range("C2", .Cells(.Rows.Count, 3).End(xlUp)).Value2
End With

For A = 1 To Ubound(meAr)
 If Not oDic.exists(meAr(A, 1)) Then
  oDic(meAr(A, 1)) = 0
  oDic(meAr(A, 1)) = 1 '1 
 Else
  oDic(meAr(A, 1)) = oDic(meAr(A, 1)) + 1 'Zählen 
 End If
Next

With Sheets("Tabelle2")
    'Überschrift 
    .Cells(1, 1) = "ID-Name"
    .Cells(1, 2) = "Anzahl"
    .Range("A1:B1").Font.Bold = True
    'Bereich leer machen 
    .Cells(2, 1).Resize(.Cells(.Rows.Count, 1).End(xlUp).Row + 1, 2).ClearContents
    'Daten in Spalte 1 schreiben 
    .Cells(2, 1).Resize(oDic.Count) = Application.Transpose(oDic.keys)
    .Cells(2, 2).Resize(oDic.Count) = Application.Transpose(oDic.items)
End With


End Sub
Gruß Tino
Anzeige
VIelen DAnk allen Beteiligten
28.12.2009 14:53:28
Claudia
Matthias: Habe das leider übersehen mit dem Spezialfilter (da kenne ich mich nicht so ganz mit aus)
Tino: Super Lösung, besten Dank!
@ Tino
28.12.2009 15:06:56
Claudia
Hallo Tino,
doch noch eine Bitte.
Wie muss ich die VBA-Lösung ändern, wenn ich auf die ID-Nr. abfragen will, zusätzlich aber auch den Klartext "ID-Name" mit in die Auswertung übernehmen?
Vielen Dank!
LG
Claudia
kannst mal testen...
28.12.2009 15:30:49
Tino
Hallo,
müsste funktionieren.
Sub Beispiel()
Dim oDic As Object, oDicNamen As Object, meAr()
Dim A As Long

Set oDic = CreateObject("Scripting.Dictionary")
Set oDicNamen = CreateObject("Scripting.Dictionary")

'Tabelle anpassen 
With Sheets("Tabelle1")
 'Bereich anpassen, hier ohne Überschrift, hier A2 bis letzte in C 
 'A=ID-Nr,  C=ID-Name 
 meAr = .Range("A2", .Cells(.Rows.Count, 3).End(xlUp)).Value2
End With

For A = 1 To Ubound(meAr)
 If Not oDic.exists(meAr(A, 1)) Then
  oDic(meAr(A, 1)) = 0
  oDic(meAr(A, 1)) = 1 '1 
  oDicNamen(meAr(A, 1)) = meAr(A, 3) 'ID-Name 
 Else
  oDic(meAr(A, 1)) = oDic(meAr(A, 1)) + 1 'Zählen 
 End If
Next


With Sheets("Tabelle2")
    'Überschrift 
    .Cells(1, 1) = "ID-Nr"
    .Cells(1, 2) = "ID-Name"
    .Cells(1, 3) = "Anzahl"
    .Range("A1:C1").Font.Bold = True
    'Bereich leer machen 
    .Cells(2, 1).Resize(.Cells(.Rows.Count, 1).End(xlUp).Row + 1, 3).ClearContents
    'Daten in Spalte 1 schreiben 
    'ID-Nr. 
    .Cells(2, 1).Resize(oDic.Count) = Application.Transpose(oDic.keys)
    'ID-Name 
    .Cells(2, 2).Resize(oDic.Count) = Application.Transpose(oDicNamen.items)
    'Anzahl 
    .Cells(2, 3).Resize(oDic.Count) = Application.Transpose(oDic.items)
End With


End Sub
Gruß Tino
Anzeige
Korrektur ID-Nr. steht ja in B bei Dir
28.12.2009 15:42:23
Tino
Hallo,
Sub Beispiel()
Dim oDic As Object, oDicNamen As Object, meAr()
Dim A As Long

Set oDic = CreateObject("Scripting.Dictionary")
Set oDicNamen = CreateObject("Scripting.Dictionary")

'Tabelle anpassen 
With Sheets("Tabelle1")
 'Bereich anpassen, hier ohne Überschrift, hier A2 bis letzte in C 
 'B=ID-Nr,  C=ID-Name 
 meAr = .Range("B2", .Cells(.Rows.Count, 3).End(xlUp)).Value2
End With

For A = 1 To Ubound(meAr)
 If Not oDic.exists(meAr(A, 1)) Then
  oDic(meAr(A, 1)) = 0
  oDic(meAr(A, 1)) = 1 '1 
  oDicNamen(meAr(A, 1)) = meAr(A, 2) 'ID-Name 
 Else
  oDic(meAr(A, 1)) = oDic(meAr(A, 1)) + 1 'Zählen 
 End If
Next


With Sheets("Tabelle2")
    'Überschrift 
    .Cells(1, 1) = "ID-Nr"
    .Cells(1, 2) = "ID-Name"
    .Cells(1, 3) = "Anzahl"
    .Range("A1:C1").Font.Bold = True
    'Bereich leer machen 
    .Cells(2, 1).Resize(.Cells(.Rows.Count, 1).End(xlUp).Row + 1, 3).ClearContents
    'Daten in Spalte 1 schreiben 
    'ID-Nr. 
    .Cells(2, 1).Resize(oDic.Count) = Application.Transpose(oDic.keys)
    'ID-Name 
    .Cells(2, 2).Resize(oDic.Count) = Application.Transpose(oDicNamen.items)
    'Anzahl 
    .Cells(2, 3).Resize(oDic.Count) = Application.Transpose(oDic.items)
End With


End Sub
Gruß Tino
Anzeige
@ Tino: Super, danke schön! oT
28.12.2009 15:51:13
Claudia
AW: Help! Zählenwen
29.12.2009 13:13:56
Ramses
Hallo
Warum mit VBA ?
Daten - Filter - Spezialfilter
Ohne Duplikate
An andere Stelle kopieren
Fertig
Gruss Rainer
Oupps. Sorry. Da hat mein IE gesponnen o.w.T.
29.12.2009 13:14:39
Ramses
...

Beliebteste Forumthreads (12 Monate)

Anzeige
Jetzt das Excel-Portal bewerten: Deine Stimme zählt!

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige