Supportnet / Forum / Tabellenkalkulation
Text automatisch einrücken
Frage
Hallo
Ich habe eine Tabelle mit einer Spalte(1) in der stehen Zahlen von 0 bis 5. Zwei Spalten links davon ist eine Spalte(2) mit Text welcher immer mit ' diesem Zeichen beginnt. Jetzt soll ein Macro die doppelte Anzahl (von Spalte(1)) von Leerzeichen direkt nach dem ' Zeichen einfügen, so dass der Text entsprechend eingerückt wird. Und das ganze dann in eine Schleife packen in der ich angeben kann für wie viel Zeilen ich das machen möchte. (z.Z. ca. 1500)
Danke für jede Hilfe.
S. Schubert
Beispiel: _=Leerzeichen
Vorher:
Spalte(2)-------------------------->Spalte(1)
'Schönes Wetter--------------->1
'Morgen auch?------------------>5
Nachher:
Spalte(2)-------------------------->Spalte(1)
'__Schönes Wetter------------>1
'__________Morgen auch?->5
Antwort 1 von Guenter
Hallo,
hier ein schneller Vorschlag. Das muss wahrscheinlich noch angepasst werden. Kennst Du Dich aus?
Erste Zeile sind Überchriften, Spalte A der Text, Spalte C die Zahlen.
versuche mal, ob es bei Dir läuft.
Gruß
Günter
hier ein schneller Vorschlag. Das muss wahrscheinlich noch angepasst werden. Kennst Du Dich aus?
Option Explicit
Sub test()
Dim Zeilenzahl%
Dim AnzLeer%
Dim n%, m%
Dim Leer$, LeerStart$, Text$
Zeilenzahl = InputBox("Anzahl der Zeilen eingeben")
For n = 2 To Zeilenzahl + 1
AnzLeer = Cells(n, 3).Value * 2
LeerStart = " "
Leer = ""
For m = 1 To AnzLeer
Leer = Leer & LeerStart
Next m
Text = Cells(n, 1).Value
Cells(n, 1).Value = Left(Text, 1) & Leer & Mid(Text, 2)
Next n
End Sub
Erste Zeile sind Überchriften, Spalte A der Text, Spalte C die Zahlen.
versuche mal, ob es bei Dir läuft.
Gruß
Günter
Antwort 2 von nighty
hi alle :)
tastet automatisch tabellengroesse ab und sucht das besagte zeichen das ergaenzt wird.
gruss nighty
Sub Makro1()
With Worksheet
Set LastCell = ActiveSheet.Cells.SpecialCells(xlLastCell)
alta = LastCell.Row
a = LastCell.Row
Do While Application.CountA(Rows(a)) = 0 And a <> 1
a = a - 1
Loop
alta = a
altb = LastCell.Column
b = LastCell.Column
Do While Application.CountA(Columns(b)) = 0 And b <> 1
b = b - 1
Loop
altb = b
lzeile = alta
lspalte = altb
For t% = 1 To lspalte
For t1% = 1 To lzeile
rem hier gegebenenfalls aendern
If Mid$(Cells(t1%, t%), 1, 1) = "`" Then Cells(t1%, t%) = "` "
Next t1%
Next t%
End With
End Sub
tastet automatisch tabellengroesse ab und sucht das besagte zeichen das ergaenzt wird.
gruss nighty
Sub Makro1()
With Worksheet
Set LastCell = ActiveSheet.Cells.SpecialCells(xlLastCell)
alta = LastCell.Row
a = LastCell.Row
Do While Application.CountA(Rows(a)) = 0 And a <> 1
a = a - 1
Loop
alta = a
altb = LastCell.Column
b = LastCell.Column
Do While Application.CountA(Columns(b)) = 0 And b <> 1
b = b - 1
Loop
altb = b
lzeile = alta
lspalte = altb
For t% = 1 To lspalte
For t1% = 1 To lzeile
rem hier gegebenenfalls aendern
If Mid$(Cells(t1%, t%), 1, 1) = "`" Then Cells(t1%, t%) = "` "
Next t1%
Next t%
End With
End Sub