Häufigkeitsermittlung und Wertkopierung in Tabelle

[LeonMaybach]

Hallo ihr lieben, ich habe schon gegoogled und auch hier gesucht aber die richtige Antwort noch nicht gefunden.

Ich habe hier einen Screenshot einer Beispieltabelle.

Bisher habe ich folgendes erreicht:

In Spalte A werden alle gleichen Werte ROT dargestellt.
Diese muss ich dann in Spalte G eintragen und dann noch in die Formel -> =ZÄHLENWENN(A:A;"=SCT00001") <- die SCT00001 hinter dem = einfügen damit er mir die Häufigkeit aus Spalte A anzeigt.

Ich möchte aber das die Werte aus Spalte A automatisch in die Spalte G eingetragen werden sobald diese 2 mal oder öfter in Spalte A auftauchen. Dazu möchte ich das sie in spalte G nur ein mal eingetragen werden und das in Spalte H die Häufigkeit des Wertes in Spalte G aus der Spalte A aufgezählt werden.

Momentan habe ich zwar eine Lösung gefunden, aber diese macht es doch noch sehr umständlich für mich und kostet mich Zeit was unproduktiv ist.

Wäre super wenn da jemand von euch ne Lösung aus dem Ärmle zaubern kann.

Mit freundlichen Grüßen

Leon

PS: Ich kann die Tabelle von Arbeit aus nicht hochladen werde dies nachtragen, wenn jemand trotzdem weiß was ich meine wäre eine Formel oder Hilfe echt super

[Gast 123]

Hallo Leon,

PS: Ich kann die Tabelle von Arbeit aus nicht hochladen

ist m.E. nicht erfoderlich, die Aufgabe ist für mich auch so zu verstehen.  Ich gehe vielleicht einen etwas ungewöhnlichen Weg, das hat mit praktischer Erfahrung zu tun.  Mein Vorschlag ist eine Kombination aus Vba Makro und deiner Formel.

Nun weiss ich nicht ob bei euch Makros zugelassen sind??  Du kannst es trotzdem mal für dich privat testen. 
Kopiere das untere Makro in ein normales Modulblatt, setze den Cursor in den Text von "Sub kopieren_" und starte mit Taste F5.
Es kopiert die Spalte A nach G, sortiert die Werte, und löscht alle Doppelten.  Jetzt zeigt dir die Formel die Anzahl in Spalte A an.

Sollte bei euch kein Makro zugelassen sein kopiere einfach Spalte A komplett nach G und rufe die Excel Funktion auf:  Dupletten löschen!
Anschliessend in Spalte H deine "ZAEHLENWENN" Formel einfügen

mfg Gast 123

Code:

Option Explicit
Const Adr1 = "G1"   '1. Adresse in Spalte G
Dim AC As Object, lz As Long

'Modul zum kopieren und doppelte löschen

Sub Kopieren_doppelte_löschen()
   
   Sheets("Tabelle1").Select
   lz = Cells(Rows.Count, 7).End(xlUp).Row

   'Spalte A nach G kopieren, sortieren
   Columns(1).Copy Columns(7)
   Call SpalteG_sortieren   'Sortier Makro
   
   'doppelte löschen, danach sortieren
   For Each AC In Range(Adr1, "G" & lz)
       If AC.Offset(1, 0) = AC.Value Then AC.Value = ""
   Next AC
   
   Call SpalteG_sortieren   'Sortier Makro
End Sub


Sub SpalteG_sortieren()     'Sortier Makro
   lz = Cells(Rows.Count, 7).End(xlUp).Row
   Range(Adr1, "G" & lz).Sort Key1:=Range(Adr1), Order1:=xlAscending, Header:= _
      xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
End Sub

[GMG-CC]

Moin Leon,
wie du schon vermutet hast, ohne Musterdatei mit Wunschlösung ist das immer etwas problematisch ...
Aber vielleicht wolltest du es ja so haben?

[LeonMaybach]

Danke erst mal für die schnellen Antworten, werde mir jetzt beide Methoden der Reihe nach anschauen. Jetzt suche ich das Modulblatt und werde das versuchen

Mit freundlichen Grüßen

Edit: Habe mir per Onlinehlfe jetzt dieses Moduldingens und so aufgerufen.
Wenn ich dann das leere Modulblatt habe und auf spiechern klicken möchte, dann sagt er mir aber folgendes:

Die folgenden Features können in Arbeitsmappen ohne Makros nicht gespeichert werden:

-VB Projekt

Zum Speichern einer Datei mit diesen Feature klicken Sie auf Nein. Wählen Sie dann einen Dateityp mit aktivierten Makros in der Liste Dateityp aus.

Klicken Sie auf Ja um die Datei als Arbeitsmappe ohne Makros zu speichern.

Habe jetzt die makros aktiviert und versuche es noch mal melde mich danach und editiere hier weiter :)

So, kann das jetzt immer noch nicht abspeichern obwohl ich alle makros aktivert habe und die Einstellung gespeichert habe.

Jetzt habe ich dann begriffen wo ich den Kursor hinsetzen soll, also in dem Modulblatt und habe dann F5 gedrückt.

Dann kommt ein Fenster mit der "Fehlermeldung":

Laufzeitfehler "9"

Index außerhalb des gültigen Bereichs

Fortfahren (grau hinterlegt) Beenden Debuggen Hilfe

Wenn ich auf Debuggen klicke dann wird "Sheets("Tabelle1").Select im Modulfenster gelb markeiert :(

So Fehler gefunden, Tabelle hieß Tabelle 3 bei mir. Jetzt ist der Fehler der gleiche aber es wird eine andere Stelle gelb markiert:

Range(Adr1, "G" & lz).Sort Key1:=Range(Adr1), Order1:=xlAscending, Header:= _

       xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom

Meine Liste startet erst bei Zeile 5 mit der Tabellenüberschrift und ab Zeile 6 gibt es erst Daten, ist da vielleicht der Fehler?

Diese Makrolösung sieht für mich sehr komfortabel und Produktiv aus, auch wenn ich mich damit noch nie auseinandergesetzt habe.

[Gast 123]

Hallo Leon

In meiner Datei befand sich zum Testen die "Tabelle1", bei dir wird das ausgewaehlte Blatt dann anders heissen!
Bitte den Blattnamen  Sheets.("Tabelle1")  im Makro von Hand aendern, oder die ganze Zeile komplett löschen.
Dann sollte es klappen....

mfg Gast 123

[LeonMaybach]

Hallo Leon

In meiner Datei befand sich zum Testen die "Tabelle1", bei dir wird das ausgewaehlte Blatt dann anders heissen!
Bitte den Blattnamen  Sheets.("Tabelle1")  im Makro von Hand aendern, oder die ganze Zeile komplett löschen.
Dann sollte es klappen....

mfg Gast 123

Das habe ich schon per Hand geändert da es mir ja aufgefallen ist, aber mit der letzten Zeile bin ich überfordert.

Muss ich da vielleicht auch noch etwas anpassen?

Mit freundlichen Grüßen

Leon

Edit: Fehlermeldung:

Laufzeitfehler 1004:

Die Sort-Methode des Range-Objektes konnte nicht ausgeführt werden

Fortfahren (grau hinterlegt) Beenden Debuggen Hilfe

Jetzt habe ich mir mal mein Datenblatt angeschaut nachdem ich das Makrodingsda von dir gemacht habe und jetzt sind alle Einträge aus Spalte A auf Spalte G kopiert worden, allerdings 1:1 :(

[Gast 123]

Hallo Leon

es freut mich das mein Programm schon mal teilweise richtig laeuft.  Ich raetsele aber selbst daran warum die Sortierroutine versagt??  
Es ist zwar eine aeltere Version von Excel 2003, aber bisher lief sie auch zuverlaessig auf höheren Versionen.

Du kannst den Sortier Code nur mal zum Adressen Testen wie unten aendern. Wenn die Adressierung richtig klappt siehst du das am Selections Bereich und der MsgBox die dir lz = LastZell und Adr1 als Adresse ausgibt.  Bei Fehler gelbe Zeile!  Die Adr1, d.h. erste Zeile zum Sortieren kannst du oben in der Const Anweisung selbst bestimmen.  Schreibe einfach "G6" hinein, dann beginnt die First Adresse in Spalte G mit der 6. Zeile!

Achte bitte auch auf die Schreibweise nach Header:=, da darf keine Leerzeile zu xlGuess sein !!
Tasten wir uns mal Schritt für Schritt an den Fehler heran!!

mfg  Gast 123

Code:

Sub SpalteG_sortieren()     'Sortier Makro
  lz = Cells(Rows.Count, 7).End(xlUp).Row
  Range(Adr1, "G" & lz).Select
  Range(Adr1).Activate
MsgBox lz & "  " & Adr1
Exit Sub

  Range(Adr1, "G" & lz).Sort Key1:=Range(Adr1), Order1:=xlAscending, Header:= _
     xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom

  '###  diese Schreibweise ist falsch !!  Nach Header:= darf keine Leerzeile sein !!  ###
  Range(Adr1, "G" & lz).Sort Key1:=Range(Adr1), Order1:=xlAscending, Header:= _

     xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
End Sub

[LeonMaybach]

Guten Morgen,

als erstes Danke für deine Hilfe !

Aaaalsoooo, mein Code sieht jetzt wie folgt aus:

Code:

Option Explicit
Const Adr1 = "G6"   '1. Adresse in Spalte G
Dim AC As Object, lz As Long

'Modul zum kopieren und doppelte löschen

Sub Kopieren_doppelte_löschen()
   
   Sheets("Tabelle1").Select
   lz = Cells(Rows.Count, 7).End(xlUp).Row

   'Spalte A nach G kopieren, sortieren
   Columns(1).Copy Columns(7)
   Call SpalteG_sortieren   'Sortier Makro
   
   'doppelte löschen, danach sortieren
   For Each AC In Range(Adr1, "G" & lz)
       If AC.Offset(1, 0) = AC.Value Then AC.Value = ""
   Next AC
   
   Call SpalteG_sortieren   'Sortier Makro
End Sub


Sub SpalteG_sortieren()     'Sortier Makro
  lz = Cells(Rows.Count, 7).End(xlUp).Row
  Range(Adr1, "G" & lz).Select
  Range(Adr1).Activate
MsgBox lz & "  " & Adr1
Exit Sub

  Range(Adr1, "G" & lz).Sort Key1:=Range(Adr1), Order1:=xlAscending, Header:= _
     xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom

Wenn ich oben bei Sub kopieren reinklicke kommt Laufzeitfehler9 - Index außerhalb des gültigen Bereichs.

wenn ich nur unten bei Sub SpalteG_sortieren reinklicke dann wird diese gelb markiert und es steht da: Fehler beim Kompilieren - End Sub erwartet

wenn ich alles lösche und das reinkopiere was du als erstes gesagt hast, dann kommt auch auf einmal der Laufzeitfehler 9 - index außerhalb des gültigen bereichs

Ich verstehe es einfach nicht -.-

[Gast 123]

Hallo Leon,

lass dich von kleinen Rückschlaegen nicht entmutigen.  Ich nehme an du hast wenig Erfahrung mit Vba.
Jedes Makro beginnt mit "Sub" + MakroName, und endet mit "End Sub"  Beim Kopieren habe ich wohl versehentlich End Sub nicht mitkopiert!
Bitte einfach End Sub in der Sortier Routine unten anfügen wenn es fehlt.  "Exit Sub" springt nur aus dem Programm raus, beendet es aber nicht!!

Was ist im Befehl Sub Kopieren_doppelteLöschen mit dem  Sheets("Tabelle1")  ist das richtig oder ist es bei dir die Tabelle3 ??  
Setze vor den Befehl Call Sortieren einmal ein ' Zeichen, dann wird diese Zeile grün.  Der Code wird jetzt ignoriert, nicht ausgeführt!
Laeuft dieser Code danach ohne Laufzeitfehler durch??  Dann müssen wir den Fehler nur im Makro Sortieren suchen! 

Keine Angst, den findern wir schon. Nur Geduld!  Schau mal ob beim Sortieren die MsgBox kommt, oder wieder Laufzeifehler??

mfg  Gast 123

[LeonMaybach]

WOW!

Also ich habe jetzt noch mal alles durch geschaut, war tatsächlich wieder Tabelle1, jetzt sieht der Code wie folgt aus:

Code:

Option Explicit
Const Adr1 = "G6"   '1. Adresse in Spalte G
Dim AC As Object, lz As Long

'Modul zum kopieren und doppelte löschen

Sub Kopieren_doppelte_löschen()
   
   Sheets("Tabelle3").Select
   lz = Cells(Rows.Count, 7).End(xlUp).Row

   'Spalte A nach G kopieren, sortieren
   Columns(1).Copy Columns(7)
   Call SpalteG_sortieren   'Sortier Makro
   
   'doppelte löschen, danach sortieren
   For Each AC In Range(Adr1, "G" & lz)
       If AC.Offset(1, 0) = AC.Value Then AC.Value = ""
   Next AC
   
   Call SpalteG_sortieren   'Sortier Makro
End Sub


Sub SpalteG_sortieren()     'Sortier Makro
  lz = Cells(Rows.Count, 7).End(xlUp).Row
  Range(Adr1, "G" & lz).Select
  Range(Adr1).Activate
MsgBox lz & "  " & Adr1
Exit Sub

  Range(Adr1, "G" & lz).Sort Key1:=Range(Adr1), Order1:=xlAscending, Header:= _
     xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
End Sub

Und wenn ich jetzt in den Bereich Sub Kopieren: klicke und F5 drücke dann geht alles weg, springt in die Excel Tabelle und es steht da: 87 G6 in so einem kleinen Fenster.

werde jetzt noch eben an Hand ein paar neuer Daten Testen ob es funktioniert

Melde mich und Danke schon mal

Edit: Excel stirbt mir fast, hängt sich auf und auf der rechten Spalte in G sind jetzt die gleichen Anzahl Datensätze wie links in A.
Eine Mappe mit Kompatibilitätsmodus ist aufgegangen und Excel reagiert nicht mehr.

Und dann steht da unten rechts: Berechnung wird ausgeführt 2 Prozessoren

Edit2:

Also nach dem der PC hier jetzt 5 Minuten gerechnet hat kam das Ergebnis 90 G6 raus und er hat wieder alles von links nach rechts kopiert.

Einen Fakewert den ich nachgetragen habe hat er von A (3 mal) nach G (nur 1 mal) kopiert. Allerdings steht in der Spalte H auch nur eine 1 wo jetzt aber eine 3 sein müsste.

Auch sollen ja von A nur Werte nach G kopiert werden die in Spalte A 2 mal oder öfter vorkommen.


Bisher berechne ich die Häufigkeit aus Spalte A in Spalte H mit folgender Formel:

Code:

=ZÄHLENWENN(A:A;"=SCT00001")

Bedeutet Wert A ist SCT00001 Dann musste ich diesen Wert in Spalte G eintippen damit ich weiß welche SCT das ist und dann musste ich bei jeder neuen SCT die Formel
=ZÄHLENWENN(A:A;"=SCT") einfügen und hinter SCT dann die 5 Zahlen (im Beispiel 00001) einfügen. Diese sind halt immer anders, es sei denn es handelt sich um die gleiche Quelle/Person/Produkt
Aber bei dem Makro kam jetzt auf jedenfall kein Fehler mehr!!!
Gast123, wir bekommen das hin :D Am Ende gibt's ne Belohnung :D


Edit3:

Sobald ich jetzt etwas in der Tabelle veränder berechnet er jedesmal neu -.- Ist das so gewollt? Anscheinend haben wir hier noch Pentium2 Prozessoren, kann es sein das es deshalb so langsam ist und ich das bei meinem PC zu Hause gar nicht merken würde?

Mfg