ich verzweifle ein wenig an einer Aufgabenstellung die mir aufgrund der vielen Leerzellen und dem verrutschen in die nächste Zeile einfach keine vernünftige Lösung einfallen lässt.
Es sollen Abteilungen (Arbeitsorganisationen) in einer Zelle zusammengeführt werden, um die Hierarchieebenen in einer Zelle anzuzeigen, was an sich nicht schwierig wäre, wenn alle Zellen Ausgefüllt wären.....
Als Beispiel hier nur mit 5 Spalten, im Anhang sind es ... mehr .... :39:
in A2 = Geschäftsführung
in B3 = Projekte
In C4 = EDV Projekte
D bleibt hier leer!
In E4 = Name 1
In E5 = Name 2
Aufgabe: nun soll Excel nach F4 und F5 den Autoeintrag schreiben: Geschäftsführung - Projekte - EDV Projekte (also hinter die Namen)
In D6 = Software
In E6 = Name 3
Aufgabe: nun soll Excel nach F6 den Autoeintrag schreiben: Geschäftsführung - Projekte - EDV Projekte - Software
und so weiter und so fort .... es sollen also hinter die Namen die einzelnen Organisationseinheiten zusammengeführt per Funktion / Makro geschrieben werden.
Bei 200 - 300 Zeilen die auszufüllen wären, würde ich das per & einfach zusammenfügen ..... ABER es sind fast 17.000 Zeilen für die ich das brauche und Spalte N bekommt diesen Eintrag..... da sitze ich ja Wochen dahinter. :16: :29:
"intelligente Tabelle" habe ich eingerichtet, so das ich mit Bereichen, oder Spalten arbeiten könnte
In der Beispieltabelle habe ich das eben fix manuell eingetragen ....
Da aber Namen mehreren Gruppen Zugeordnet sein können, komme ich mit sverweis nicht weiter, auch die Namen nach einzelnen Gruppen zu filtern und dann die Bereiche per dropdown Menü anzubieten hat mal gar nicht funktioniert.....
Kann mir wer hier eine Idee geben? oder eine Lösung anbieten? Wäre Spitzenklasse!
am schnellsten und einfachsten dürfte es sein, die Aufabe per Hand zu lösen.
Die Spalten A-F sollten in einen freien Bereich kopiert werden, dann alle kopierten Spalten markieren:
Taste F5 drücken, Inhalte, "leere Zellen" auswählen
Die Markierung sollte in der ersten leeren Zelle links ober stehen, dann eintippen "=" und dann mit der Maus die Zelle oberhalb, mit strg-enter abschliessen.
vielen Dank für den Versuch, diese Art des Autoausfüllens ist richtig geil! Gefällt mir und kann ich sicher sehr gut brauchen, leider klappt er nicht, denn es gibt ja Zellen die leer bleiben sollen (müssen)!
Schau dir mal bitte Zelle F13 an.... die erhält den Eintrag "Softwareverteilung" - müsste aber leer bleiben denn E13 startet eine neue Gruppe..... und der nächste Eintrag ist dann eben in F14 .....
stimmt, dann bedarf es eines kleinen Makros der diese "Spezialfälle" vorbereitet. Um die Übergänge prüfen zu können, sollten ein paar mehr Datensätze bereitgestellt werden.
Vorausgesetzt es ergäbe sich keine tiefere Struktur in Richtung ">H" könnte man dann prüfen, ob
a) in Spalte H ein Eintrag ist und dann entweder
aa) alle "Leerzeichen" und "Bindestriche" inkl. des Einrtags in Spalte "H" emtfernt werden oder
b) die Werte, die ausschließlich aus "Leerzeichen" und Bindestrichen entfernt werden.
Voraussetzung wäre in "meinem Szeneario", dass die letzte Zeile Deiner Tabelle In Spalte "I" die o.g. Formel enthält und somt alle Spalten mit Werten gefüllt wären.
diese Struktur ist gleichbleibend allerdings weitergehend bis Spalte "N".
Im Grunde soll diese Zusammenfassung von A nach M zeilenweise in Spalte N den Autoeintrag erhalten. Dabei hören halt die Einträge mal bei F auf oder gehen bis M .......
Hallo IchBinIch,
vielen Dank für deine Idee, das war mein erster Ansatz, die Zellen Zeilenweise mit einem & zu verknüpfen, und es dann einfach herunterzuziehen um diese Einträge zu erhalten .....
dabei ergaben sich folgende Probleme: Die Namenseinträge (also quasi die tatsächlichen Teilnehmer der Gruppen) erstrecken sich über die Spalten L, K und M = manche der N Einträge enthalten Namen andere nicht, es sollen aber keine Namen in N stehen sondern nur eben die Hierachieebenen. Was ein zusätzliches manuelles Bearbeiten von mindestens 600 Zellen bedeuten würde. Und 2. Dann wieder das Problem des Autoausfüllens der Spalten bis eben zum Namenseintrag ...... was bei 17.000 Zeilen schon echte Arbeit verursacht .....
- Vorbereitung mit einem Makro, der " " (Leerzeichern) in alle Zellen einfügt, die später frei bleiben sollen
- Dublizieren aller Begriffe wie im post #1 beschrieben
- Verkettung wie von Ich... beschrieben.
Die Spaltenstruktur (manchmal bis M) erfordert einige "geschickte" Bedingungen im Makro. Da nur der Fragesteller die Struktur kennt, sollte er den Makro schreiben. Nach der gezeigten Datei geht das zwar in einem ersten Anlauf, aber einige Details werden verbessert werden müssen.
Deshalb die sehr direkte Frage: wie gut kann der Fragesteller vba Codes schreiben?
08.09.2016, 08:44 (Dieser Beitrag wurde zuletzt bearbeitet: 08.09.2016, 08:44 von IchBinIch.
Bearbeitungsgrund: Ergänzung
)
Hallo Hagen,
hallo Fennek,
es geht vielleicht auch über ein Makro anders.
Voraussetzung dafür wäre aber, dass die Namen alle in einer Spalte stehen.
Über en Makro kann man dann ermitteln welches die letzte gefüllte Zelle in der jeweiligen Zeile ist
und alle davor befindlichen Zellinhalte wie von mir oben vorgeschlagen miteinander verketten.
Man lässt also die Namensspalte völlig unberücksichtigt und prüft alle davor liegenden Spalten.
Im Ergebnis sollte so die von Hagen erwünschte Struktur entstehen.
Gruß
Ich
Im oben genannten Fall könnte ich mir auch vorstellen, dass man das evtl. über eine Formel realisieren kann.
Dafür bin ich aber zu wenig formelaffin :)
anbei ein Code, der in der Beispieldatei gut aussieht. ABER: Der Code ist m.M.n. monströs und weder für andere noch für mich nach einer Stunde zu überblicken.
Wenn etwas nicht stimmt, dann viel Spaß, ich werde mich mit diesem Thema nicht mehr beschäftigen!
Code:
Sub test()
Dim c As Range
Dim L_Sp
lr = ActiveSheet.Cells.SpecialCells(11).Row
ReDim L_Sp(lr)
For Each r In ActiveSheet.UsedRange.Rows
ls = Cells(r.Row, Columns.Count).End(xlToLeft).Column
If ls > 1 Then
If Not IsEmpty(Cells(r.Row, ls - 1)) Then
o = 0
Do
Cells(r.Row + o, ls).Interior.Color = vbYellow
L_Sp(r.Row + o) = ls - 1
o = o + 1
Loop Until Cells(r.Row + o, ls) = ""
End If
End If
Next r
For Each c In ActiveSheet.UsedRange.SpecialCells(2)
For i = 1 To 13 - c.Column
If c.Offset(, i).Value = "" Then c.Offset(, i) = " " 'c.Offset(, i).Interior.Color = vbYellow
Next i
Next c
With ActiveSheet.UsedRange.SpecialCells(4)
.FormulaR1C1 = "=R[-1]C"
End With
With ActiveSheet.UsedRange '.SpecialCells(3)
.Value = .Value
End With
For i = 1 To lr
j = IIf(L_Sp(i) = 0, 13, L_Sp(i))
Cells(i, "O") = Join(Application.Transpose(Application.Transpose(Range(Cells(i, "A"), Cells(i, j)))), " - ")
Next i
For Each c In ActiveSheet.UsedRange.Columns("O").Cells
For i = Len(c.Value) To 1 Step -1
If Not Mid(c.Value, i, 1) Like "[a-z]" Then
c.Value = Left(c.Value, i)
Else
Exit For
End If
Next i
Next c
hier noch eine Lösung wenn die Tabelle entsprechend vorbereitet wird.
Arbeitsblatt mit dem Namen 'Tabelle2'
A
B
C
D
E
F
G
H
2
Geschäftsführung
3
Geschäftsführung
Projektplanung
4
Geschäftsführung
Projektplanung
Projektorganisation
5
Geschäftsführung
Projektplanung
Projektorganisation
EDV Projekte
6
Geschäftsführung
Projektplanung
Projektorganisation
EDV Projekte
Software Projekte
7
Geschäftsführung
Projektplanung
Projektorganisation
EDV Projekte
Software Projekte
Adobe-Photoshop
Tina Müller
8
Geschäftsführung
Projektplanung
Projektorganisation
EDV Projekte
Software Projekte
Adobe-Photoshop
Gerd Meier
9
Geschäftsführung
Projektplanung
Projektorganisation
EDV Projekte
Software Projekte
Adobe-Photoshop
Karl Egon
10
Geschäftsführung
Projektplanung
Projektorganisation
EDV Projekte
Software Projekte
Adobe-Katalog
Tina Müller
11
Geschäftsführung
Projektplanung
Projektorganisation
EDV Projekte
Software Projekte
Adobe-Katalog
Franz Hauser
12
Geschäftsführung
Projektplanung
Projektorganisation
EDV Projekte
Software Projekte
Softwareverteilung
Karl Knauser
13
Geschäftsführung
Projektplanung
Projektorganisation
EDV Projekte
Hardware Projekte
14
Geschäftsführung
Projektplanung
Projektorganisation
EDV Projekte
Hardware Projekte
15
Geschäftsführung
Projektplanung
Projektorganisation
EDV Projekte
Hardware Projekte
Rollout Planung
Desktop PC
Heinz Hinz
16
Geschäftsführung
Projektplanung
Projektorganisation
EDV Projekte
Hardware Projekte
Rollout Planung
Desktop PC
Clara Bauer
17
Geschäftsführung
Projektplanung
Projektorganisation
EDV Projekte
Hardware Projekte
Rollout Planung
Desktop PC
Stefanie Weich
18
Geschäftsführung
Projektplanung
Projektorganisation
EDV Projekte
Hardware Projekte
Rollout Planung
Notebook
Karl Bräuer
19
Geschäftsführung
Projektplanung
Projektorganisation
EDV Projekte
Hardware Projekte
Rollout Planung
Notebook
Sven Michel
20
Geschäftsführung
Projektplanung
Projektorganisation
EDV Projekte
Hardware Projekte
Rollout Planung
Notebook
Nico Jannis
Und der dazu gehörige Code:
Modul Modul1
OptionExplicit Sub HagenVerkettung() Dim s AsLong Dim z AsLong Dim zm AsLong
With Tabelle2
zm = .Cells(Rows.Count, 1).End(xlUp).Row For z = 2To zm For s = 7To1Step -1 IfNot IsEmpty(.Cells(z, s)) Then
.Cells(z, 9).Value = .Cells(z, s).Value & " - " & .Cells(z, 9).Value EndIf Next s
.Cells(z, 9).Value = Left(.Cells(z, 9).Value, Len(.Cells(z, 9).Value) - 3) Next z
.... :39: 