Hallo alle zusammen,
ich stoße an meine Excel-Grenzen. ich habe eine Tabelle in der Personen in verschiedene Kurse eingeteilt sind. Die Kurse haben die z. B. die Nummer 1 bis 4 und rechts daneben (nächste Spalte) steht der Name.
Beispiel
Kurs Name
1 Hans
1 Peter
1 Klaus
2 Georg
4 Werner
2 Sebastian
4 Heino
4 Oliver
2 Gunther
3 Michael
3 Sebastian2
2 Horst
3 Frank
Jetzt möchte ich auf einem neuen Tabellenblatt folgende Tabelle angezeigt bekommen.
Kurs 1 Kurs 2 Kurs 3 Kurs 4
Hans Georg Michael Werner
Peter Sebastian Sebastian2 Heino
Klaus Gunther Frank Oliver
Horst
So einiges habe ich versucht, aber ... ohne Erfolg.
Die Tabelle habe ich beigefügt. Tabellenblatt 1 ist für die Vorgaben (Rahmenbedingungen), Tabellenblatt 2: hier stehen die Namen und die Kurse werden zugeteilt (pinker Bereich), Tabellenblatt 3: Hier sollen die Kurse nebeneinander stehen 1 bis 16 und darunter die Namen, die in diesem Kurs sind.
Danke [
attachment=5061]attachment=5061]
Hola,
bitte eine Beispieldatei ;)
Gruß,
steve1da
Hallo
bei so einer klar definierten Aufgabe braucht man keine Beispieldatei.
Im folgenden Makro muss evtl. der Tabellen Name geaendert werden.
İn der Ziel Tabelle stehen die Namen in den Spalten: A, B, C, D
Sollten andere Spalten gewünscht sein muss man es aendern.
Bitte in ein Modul laden und ausprobieren, ggf. aendern wir die Adressen.
mfg Gast 123
Sub Gleiche_suchen_und_auflisten()
Dim a, b, c, d 'Kurse in Tab2
Dim AC As Object, Txt As String
Dim Tab1 As Object, Tab2 As Object
Set Tab1 = Worksheets("Tabelle1")
Set Tab2 = Worksheets("Tabelle2")
'alte Tabelle löschen
Tab2.Range("A2:D1000").ClearContents
'a-d Zaehler für Kurs 1-4
a = 2: b = 2: c = 2: d = 2
'Schleife zum kopieren aller Daten aus Tabelle1 in Tabelle2
For Each AC In Tab1.Range("A2", Tab1.[a2].End(xlDown))
Txt = AC.Cells(1, 2).Value 'Txt = Mitglied Name
If AC = 1 Then Tab2.Cells(a, AC) = Txt: a = a + 1
If AC = 2 Then Tab2.Cells(b, AC) = Txt: b = b + 1
If AC = 3 Then Tab2.Cells(c, AC) = Txt: c = c + 1
If AC = 4 Then Tab2.Cells(d, AC) = Txt: d = d + 1
Next AC
End Sub
Sorry, da ist ein Smily reingerutscht der da nicht hingehörte.
'alte Tabelle löschen
Tab2.Range("A2:D1000").ClearContents
ich kriege langsam einen Affen, wieder ein Smily !!
Der Text lautet: Tab2.Range("A2:D1000").ClearContents
hoffentlich diesmal ohne Grinsmann
Spalte A2 bis D1000 - grinst du jetzt immer noch, dann kannst du mir kreuzweise ...
Hi,
schalte den Grinsemann doch aus: dazu in der Antwort Haken bei Smilies deaktivieren: Smilies in diesem Beitrag nicht anzeigen. setzen. Und gut ist.
Hallo,
Tabelle als intelligente Tabelle formatieren, dann erweitert die sich bei jedem neuen Eintrag mitsamt den Formeln.
Überschriften in Einteilung ändern, dann mit dieser Formel:
[html]
| Arbeitsblatt mit dem Namen 'Kurse mit Teilnehmer' |
| | B |
| 1 | AG Nr 1 |
| 2 | AG-Witz |
| 3 | Herbert, Klaus |
| 4 | Karl, Musterer |
| 5 | |
| 6 | |
| Zelle | Formel |
| B3 | {=WENNFEHLER(INDEX(Einteilung!$G:$G;KKLEINSTE(WENN(Einteilung!$E$5:$E$12=$B$1;ZEILE(Einteilung!$E$5:$E$12));ZEILE(A1)));"")} |
| Achtung, Matrixformel enthalten! |
| Die geschweiften Klammern{} werden nicht eingegeben. |
| Verlassen Sie den Zelleneditor mit Strg+Shift + Enter, statt Enter alleine. |
| Diese Tabelle wurde mit Tab2Html (v2.4.1) erstellt. ©Gerd alias Bamberg |
[/html]
@Gast123,
nicht jeder kann, darf und will VBA einsetzen noch dazu es verstehen. So wie manche Probleme mit Smilies haben :19: :19:
Danke für die schnelle Hilfe,
VBA ist leider nicht möglich, aber die Formel habe ich ausprobiert ... Sie übersteigt meine Vorstellungskraft. Ich habe das 2. Tabellenblatt in eine intelligente Tabelle umgewandelt. Das stellt sich für mich schon die Frage - mit oder ohne Überschrift ...
Wenn ich dann die Formel hinein kopiere, dann ist die Zelle A1 rot gefärbt, aber da steht nix drin ... und es passiert nix. Was mache ich falsch?
Danke schon mal im Voraus für die viele Hilfe.
Hallo,
Du mußt die erste Tabelle als intelligente Tabelle formatieren und die Formel als Matrixformel eingeben!