Supportnet / Forum / Tabellenkalkulation

Hallo Liebe Leute! Ich steh mal wieder voll auf der Leitung! Ich habe eine 6-Stellige Zahl (Konten) die ich Gliedern möchte! Dies soll wie folgt aussehen: Sp1 Sp2 Sp3 Sp4 Sp5 5 Bezeichnung 51 Bezeichnung 513 Bezeichnung 513650 Bezeichnung(Ursprung) Hat hierzu jemand eine praktikable Lösung? Über Verketten möchte ich dann in einer Spalte nur einen Wert haben und dann die entsprechende Bezeichnung mit einem "SVWeis" zuordnen. Vielen Dank im Voraus!

Hallo,

nicht ganz verständlich wie du schreibst

vielleicht etwas besser erläutern, kommt vielleicht auch durch die verschobene Darstellung

Gruß

Helmut

Morgen!
Man sollte sich die Vorschau mal anschauen...

Also auf ein Neues:

Spalte 1 Zeile 1: 5
Spalte 2 Zeile 2: 51
Spalte 3 Zeile 3: 513
Spalte 4 Zeile 4: 513650 (Ursprung)
Spalte 1 Zeile 5: 6
Spalte 2 Zeile 6: 62
Spalte 3 Zeile 7: 621
Spalte 4 Zeile 8: 621350 (Ursprung)

Spalte 5: jeweils die Bezeichnung

Die Ursprungsnummer ist die, die vorgegeben ist und aus der der Rest entstehen soll.

Ich hoffe, ich habe mich diesmal verständlicher ausgedrückt!
Gruss
Platin7

Hi Platin7,

in A1 die Formel: =LINKS(D4;1)
in B3 die Formel:=LINKS(D4;2)
in C3 die Formel:=LINKS(D4;3)

CU Aliba

Hallo Aliba!
Prima, aber das weitere Problem ist, das an den entsprechenden Stellen neue Zeilen eingefügt werden sollen!

Ergebnis:

Spalte 1 Zeile 1: 5
Spalte 2 Zeile 2: 51
Spalte 3 Zeile 3: 513
Spalte 4 Zeile 4: 513650 (Ursprung)
Spalte 1 Zeile 5: 6
Spalte 2 Zeile 6: 62
Spalte 3 Zeile 7: 621
Spalte 4 Zeile 8: 621350 (Ursprung

Basis:

Spalte 4 Zeile 9: 631350
Spalte 4 Zeile 10: 751420
Spalte 4 Zeile 11: 751433

Ich benötige also auch neue Zeilen daszwischen!

Danke trotzdem!

Hallo,

versuch es mal mit folgenden VBA-Code:

Option Explicit

Sub Gliederung()
Dim loZeile As Long, loLetzte As Long, rng As Range
Application.ScreenUpdating = False
loZeile = 1
Do
Rows(loZeile & ":" & loZeile + 2).Insert Shift:=xlDown
loZeile = loZeile + 4
loLetzte = IIf(IsEmpty(Cells(Rows.Count, 4)), Cells(Rows.Count, 4) _
.End(xlUp).Row, Rows.Count)
Loop While loZeile <= loLetzte
For Each rng In Range(Cells(1, 4), Cells(loLetzte, 4))
If rng <> "" Then
Cells(rng.Row - 3, 1) = Left(rng, 1)
Cells(rng.Row - 2, 2) = Left(rng, 2)
Cells(rng.Row - 1, 3) = Left(rng, 3)
End If
Next
Application.ScreenUpdating = True
End Sub

Gruß

JöKe

Hallo JöKe!
Du bist der Held!!!
Klappt prima!

Hat man so was in der Schublade liegen, oder machst Du das mal eben auf die Schnelle?

Vielen Dank auf jedenfall!

Platin7

Hallo Platin,

sowohl als auch. ;-)

Und vielen Dank für die Rückmeldung.

Gruß

JöKe

Hallo JöKe!
Es hat sich in der Zwischenzeit noch ein kleines Problem ergeben.
Bei Deiner Methode bekomme ich für jedes Konto die Hierachie! Ich bräuchte die Stufen aber eigentlich nur jeweils einmal. Der Rest, also die dazugehörigen Konten der Stufen sollten einfach angehängt werden.

Würg!!! Das ist echt schwer in Worte zu fassen!

Vielleicht fällt Dir dazu ja noch was ein!
Gruss
Platin7

Hallo Platin7,

sollte mit folgenden Code funktionieren:

Sub GliederungII()
Dim loZähler As Long, loLetzte As Long, i As Long
Application.ScreenUpdating = False
loZähler = 1
Do
If Left(cells(loZähler, 4), 3) = Left(cells(loZähler + 1, 4), 3) Then
loZähler = loZähler + 1
ElseIf Left(cells(loZähler, 4), 3) <> Left(cells(loZähler + 1, 4), 3) Then
Rows(loZähler + 1 & ":" & loZähler + 3).Insert Shift:=xlDown
loZähler = loZähler + 4
End If
loLetzte = IIf(IsEmpty(cells(Rows.Count, 4)), cells(Rows.Count, 4) _
.End(xlUp).Row, Rows.Count)
Loop While loZähler <= loLetzte
i = 4
Do
If cells(i, 4) <> "" And cells(i - 1, 4) = "" Then
cells(i - 3, 1) = Left(cells(i, 4), 1)
cells(i - 2, 2) = Left(cells(i, 4), 2)
cells(i - 1, 3) = Left(cells(i, 4), 3)
End If
i = i + 1
Loop While i <= loLetzte
Application.ScreenUpdating = True
End Sub

Hierbei habe ich allerdings angenommen, dass die Konten erst ab der zweiten Zeile eingetragen wurden und sie sortiert sind.

Gruß

JöKe

Hallo Jöke!
Wir sind ganz nah dran!!!
Auf der Ebene der Spalte 3 ist es schon richtig!
Nun noch auf der ersten und zweiten Ebene.

Ich würde den Code aber auch ganz gern verstehen um ihn dann auf meine Bedürfnisse abzuwandeln.
Man weiß ja nie, wozu man das noch mal brauchen kann! Vielleicht kannst Du ein paar Kommentare einfügen.

Lieben Gruss
Platin7

Hallo Platin,

hier ersteinmal der kommentierte Code:

Sub GliederungII()
Dim loZähler As Long, loLetzte As Long, i As Long
Application.ScreenUpdating = False
Rem bestimmt die Zeile in der die Überprüfung beginnt
loZähler = 1
Do
Rem Überprüfung ob die linken 3 Zahlen in aufeinanderfolgenden Zeilen gleich ist
Rem Cells(loZähler,4) entspricht der Zellen in Spalte D
If Left(cells(loZähler, 4), 3) = Left(cells(loZähler + 1, 4), 3) Then
Rem wenn die beiden Werte gleich sind wird der Zeilenzähler um 1 erhöht
loZähler = loZähler + 1
ElseIf Left(cells(loZähler, 4), 3) <> Left(cells(loZähler + 1, 4), 3) Then
Rem wenn die beiden Werte ungleich sind werden vor der entsprechenden Zeile
Rem 3 Zeilen eingefügt
Rows(loZähler + 1 & ":" & loZähler + 3).Insert Shift:=xlDown
Rem und der Zeilenzähler um 4 (1 für den nächsten Wert und 3 für die Leerzeilen erhöht
loZähler = loZähler + 4
End If
Rem die letzte belegte Zelle in Spalte D wird ermittelt
loLetzte = IIf(IsEmpty(cells(Rows.Count, 4)), cells(Rows.Count, 4) _
.End(xlUp).Row, Rows.Count)
Rem legtfest, dass das vorhergehende wiederholt wird, bis die letzte Zeile erreicht ist
Loop While loZähler <= loLetzte
Rem bestimmt die Zeile in der die Überprüfung beginnt
i = 2
Do
Rem wenn in Spalte D (4) eine Zelle nicht leer und die vorrige leer ist
If cells(i, 4) <> "" And cells(i - 1, 4) = "" Then
Rem dann wird in Spalte A (1) drei Zeilen höher die linke Zahl eingetragen
cells(i - 3, 1) = Left(cells(i, 4), 1)
Rem dann wird in Spalte B (2) zwei Zeilen höher die linke 2 Zahlen eingetragen
cells(i - 2, 2) = Left(cells(i, 4), 2)
Rem dann wird in Spalte C (3) eine Zeile höher die linke 3 Zahlen eingetragen
cells(i - 1, 3) = Left(cells(i, 4), 3)
End If
Rem zeilenzähler wird um 1 erhöht
i = i + 1
Rem Festlegung der Schleifen durchläufe
Loop While i <= loLetzte
Application.ScreenUpdating = True
End Sub

Gruß

Wenn du nicht weiter kommst, melde dich nochmal und beschreib mal was noch nicht so ist wie es sein soll.

Hallo JöKe!
Danke für die Beschreibung!
Aber das noch vorhandene Problem kann darau noch nicht ableiten!
Ich bekomme folgende Ergebnisse (Zeilenunterschiede habe ich hier nicht berücksichtigt, sind aber i.O.)

5---50---500---500100
5---50---501---501100 50 zu viel
5---51---510---510110 5 zu viel

Ich hoffe es wird deutlich!

Lieben Gruss
Platin7

Moin Platin,

ich habe dir hier mal meine Beispieldatei eingestellt.
In der funktioniert es so wie ich es bis jetzt verstanden habe.
Sieh sie dir mal an und lade dann bei netupload nötigenfalls eine Datei mit einem Beispiel was anderst sein soll hoch.

Gruß

JöKe

Hi!
Ja, so sieht das bei mir auch aus!
Ich möchte in der kompletteb ersten Spalte nur einmal die 1 haben und in der kompletten zweiten Spalte nur einmal die 14!
Gruss
Platin7

Hallo,

passiert bei dir etwas anderes als bei mir.

Hier kannst du sehen wie bei mir das Ergebnis aussieht.

Gruß

JöKe

Hallo Platin7,

dieser Code sollte ungefähr das machen, was Du willst. Er ist auch ziemlich einfach gestrickt, also leicht nachvollziehbar.

Sub Gliederung_3()
Dim g1 As Integer, g2 As Integer, g3 As Integer, s As Byte, w As Long, bis_zeile As Long, z As Long
Rem --- Voreinstellungen ---
Const spalte As String = "D"
Const von_zeile As Long = 2
Rem --- Voreinstellungen ---

s = Asc(UCase(spalte)) - 64
bis_zeile = IIf(IsEmpty(ActiveSheet.Cells(Rows.Count, 4)), ActiveSheet.Cells(Rows.Count, 4).End(xlUp).Row, Rows.Count)
Application.ScreenUpdating = False
z = von_zeile: g1 = 0: g2 = 0: g3 = 0
Do
w = ActiveSheet.Cells(z, s).Value
If Left(w, 1) <> g1 Then
Rem neue Gliederungsebene 1
Rows(z).EntireRow.Insert Shift:=xlDown
ActiveSheet.Cells(z, 1).Value = Left(w, 1)
g1 = Left(w, 1)
z = z + 1
bis_zeile = bis_zeile + 1
End If
If Left(w, 2) <> g2 Then
Rem neue Gliederungsebene 2
Rows(z).EntireRow.Insert Shift:=xlDown
ActiveSheet.Cells(z, 2).Value = Left(w, 2)
g2 = Left(w, 2)
z = z + 1
bis_zeile = bis_zeile + 1
End If
If Left(w, 3) <> g3 Then
Rem neue Gliederungsebene 3
Rows(z).EntireRow.Insert Shift:=xlDown
ActiveSheet.Cells(z, 3).Value = Left(w, 3)
g3 = Left(w, 3)
z = z + 1
bis_zeile = bis_zeile + 1
End If
Rem Wert in Spalte D bleibt wie er ist
z = z + 1
Loop Until z > bis_zeile
Application.ScreenUpdating = True

End Sub

Eine Schleife läuft von von_zeile (Voreinstellung, oben) bis bis_zeile (ermittelt aus letzter gefüllter Zelle in Spalte spalte (Voreinstellung, oben). Die aktuellen Gliederungsbezeichnungen werden in g1, g2 und g3 gemerkt und der Reihe nach mit der ersten, den beiden ersten und den drei ersten Stellen des Wertes in jeder Zeile verglichen. Stellt sich bei einem Vergleich heraus, dass die Gliederung nicht übereinstimmt, d. h. eine neue "begonnen" werden muss, wird eine Zeile eingefügt, die neue Gliederung in A, B bzw. C eingetragen, in g1, g2 bzw. g3 gemerkt, die Zeilenzähler z und biszeile werden eins hochgezählt und dann gehts zur nächsten Zeile: z = z + 1. Falls alle Gliederungen richtig waren, passiert gar nichts (- d. h. die Anweisungen aller drei IFs werden nicht ausgeführt), es wird nur zur nächsten Zeile gegangen (z = z + 1). Die Werte in D bleiben in jedem Fall völlig unverändert.

Gruß,
CaroS

Hallo JöKe,

ich glaube, ich weiß, worum es geht. Ändere mal die Testdaten ein bisschen. Für diese hier zum Beispiel sollen die Gleiderungsstufen 1, 14 und 2 jeweils nur beim ersten Auftreten eingetragen werden, die 14 aber nicht beim Wechsel von 141 auf 142 und auf 143. Das gewünschte Ergebnis wie ich es verstanden habe, steht darunter.

Konten (Spalte D)
141222
141223
141224
142345
143456
156780
156789
231223
231224
234567
234568
345222
345223
345224


1			
	14		
		141	
			141222
			141223
			141224
		142	
			142345
		143	
			143456
	15		
		156	
			156780
			156789
2			
	23		
		231	
			231223
			231224
		234	
			234567
			234568
3			
	34		
		345	
			345222
			345223
			345224

Gruß,
CaroS

Hallo CaroS!

Prima, Du hast es erfasst!

So habe ich es hier dann auch dargestellt!!!

http://www.netupload.de/detail.php?img=1b0731e5638fde877c854bdefc8e0c20.xls

Gruss
Platin7

@ CaroS,

Gratulation!!
Hab ich nicht erwartet, dass das so gemeint war.

@Platin,

hier sieht man mal wieder :
- Die Hilfe kann nur so gut sein, wie die Frage -
Dennoch du hast eine Lösung.

Bis zum nächsten Problem. ;-)

JöKe

Hallo allerseits,

freut mich, dass ich helfen konnte. Man kann´s ja nicht oft genug wiederholen, dass man verständliche Problembeschreibungen, den aktuellen Stand der Datei und/oder ein aussagekräftiges Beispiel braucht, um vernünftig helfen zu können. Der kleine, aber wesentliche Unterschied war, dass in der ersten Beispieldatei eben leider nicht deutlich zum Ausdruck kam, dass es mehrere untergeordnete Gleiderungsstufen geben kann und dass die höheren Gleiderungsstufen dann jeweils nur einmal aufgeführt werden sollen. Wäre das Beispiel gleich so von Platin gekommen, wäre von Anfang an alles klar gewesen. Ja, so ist das eben.

Auf zum nächsten! Man sieht (liest) sich.

Grüße,
CaroS

• wie wird eine externe festplatte partioniert
• Trennung nach drei Stellen nach Separator