Supportnet Computer
Planet of Tech

Supportnet / Forum / Tabellenkalkulation

leerzeichen einfügen in excel





Frage

Hallo zusammen, ich wuerde gerne in einer Excel-Tabelle mehrere Zeilen markieren und jeweils eine Leezeile einfuegen. Bis jetzt habe ich die entsprechenden Zeilen immer einzeln mit "Ctrl+ linke Maustaste" markiert und anschliessend "rechte Maustaste => einfuegen.." geklickt. Kann man mit VBA etwas programmieren, dass ich mehrere Zeilen "ganz normal" auswaehlen kann und anschliessend per Tastenkombioder so in diesem Bereich jeweils eine Leerzeile einfuegen kann?

Antwort 1 von Hajo_Zi

Hallo Nick,

wozu? Das bekommt amn auch mit Formtierung hin " "@

Gruß Hajo

Antwort 2 von runner007

Hi Hajo,

wie meinst du das?

Was michstoert ist, das ich "Ctrl" immer gedrueckt halten muss und jede Zeile einzeln anklicken muss. Ich wuerde die linke Maustaste einfach gerne gedrueckt halten und dann zwischen jeder Zeile jeweils eine Leerzeile einfuegen. Wenn ich das so mache wie gerade beschrieben, bekomme ich die Anzahl an Leerzeilen (die ich markiert habe) als Block eingefuegt.

Gruesse
Lars

Antwort 3 von ChatAlligator

Ich hab mal eine entsprechende Routine geschrieben und diese in diverse Unterroutinen aufgeteilt, die du gegebenenfalls für andere Zwecke mitnutzen kannst (Mehrfachauswahlen sind dabei möglich):

Option Explicit

Sub Leerzeilen()
Dim Auswahl As String, Teilauswahl As String, Zelle As Range, Fehler As Boolean
Dim AnfangX As Integer, AnfangY As Long, EndeX As Integer, EndeY As Long, Spalte As Integer, Zeile As Long
Fehler = False
Auswahl = Selection.Address
'Gültigkeitsprüfung
While Not Auswahl = ""
Call BereichsPosition(NächsterBereich(Auswahl), AnfangX, AnfangY, EndeX, EndeY)
Zeile = EndeY + 1
While Zeile < EndeY + 1 + EndeY - AnfangY And Not Fehler
Spalte = AnfangX
While Spalte <= EndeX And Not Fehler
If Not IsEmpty(Cells(Zeile, Spalte)) Then Fehler = True
Spalte = Spalte + 1
Wend
Zeile = Zeile + 1
Wend
Wend
If Fehler Then
MsgBox "Die gewünschte Funktion wird abgebrochen," & vbCrLf & "weil sie im Begriff sind" & vbCrLf & "damit gefüllte Zellen zu überschreiben"
Exit Sub
End If
'Durchführung
Range(Cells(EndeY + 1, AnfangX), Cells(EndeY + 1 + EndeY - AnfangY, EndeX)).Delete Shift:=xlUp
Auswahl = Selection.Address
While Not Auswahl = ""
Call BereichsPosition(NächsterBereich(Auswahl), AnfangX, AnfangY, EndeX, EndeY)
For Zeile = EndeY To AnfangY Step -1
Range(Cells(Zeile + 1, AnfangX), Cells(Zeile + 1, EndeX)).Insert Shift:=xlDown
Next Zeile
Wend
End Sub

Private Function NächsterBereich(Bereich As String) As String
Dim pos As Integer
pos = InStr(Bereich, ",")
If pos = 0 Then
NächsterBereich = Bereich
Bereich = ""
Else
NächsterBereich = Left(Bereich, pos - 1)
Bereich = Mid(Bereich, pos + 1)
End If
End Function

Private Sub BereichsPosition(ByVal Bereich As String, ByRef AnfangX As Integer, ByRef AnfangY As Long, ByRef EndeX As Integer, ByRef EndeY As Long)
Dim pos As Integer, Modus As Byte
pos = InStr(Bereich, ":")
If pos = 0 Then 'Einzelne Zelle wird als Anfang und als Ende definiert
pos = Len(Bereich) + 1
Bereich = Bereich & ":" & Bereich
End If
AnfangX = 1
EndeX = 256
AnfangY = 1
EndeY = 65536
If InStr(2, Bereich, "$") > 0 And InStr(2, Bereich, "$") < pos Then
Modus = 0 'Spalte und Zeile
Else
If IsNumeric(Mid(Bereich, 2, 1)) Then
Modus = 1 'Nur Zeile
Else
Modus = 2 'Nur Spalte
End If
End If
Select Case Modus
Case 0
Call EinzelPosition(Mid(Bereich, 1, pos - 1), AnfangX, AnfangY)
Call EinzelPosition(Mid(Bereich, pos + 1), EndeX, EndeY)
Case 1
Call EinzelPosition("$" & SpalteZeichen(AnfangX) & Mid(Bereich, 1, pos - 1), AnfangX, AnfangY)
Call EinzelPosition("$" & SpalteZeichen(EndeX) & Mid(Bereich, pos + 1), EndeX, EndeY)
Case 2
Call EinzelPosition(Mid(Bereich, 1, pos - 1) & "$" & Trim(CStr(AnfangY)), AnfangX, AnfangY)
Call EinzelPosition(Mid(Bereich, pos + 1) & "$" & Trim(CStr(EndeX)), EndeX, EndeY)
End Select
End Sub

Private Sub EinzelPosition(ByVal Bereich As String, ByRef X As Integer, ByRef Y As Long)
X = SpalteNr(Mid(Bereich, 2, InStr(2, Bereich, "$") - 2))
Y = CInt(Mid(Bereich, InStr(2, Bereich, "$") + 1))
End Sub

Private Function SpalteNr(ByVal Kennbuchstaben As String) As Integer
Dim temp As Integer, pos As Byte
Kennbuchstaben = Trim(Kennbuchstaben)
temp = 0
For pos = 1 To Len(Kennbuchstaben)
If pos = 1 And Len(Kennbuchstaben) = 1 Then
temp = temp + (Asc(Mid(Kennbuchstaben, pos, 1)) - 64) * 26 ^ (Len(Kennbuchstaben) - pos)
Else
temp = temp + (Asc(Mid(Kennbuchstaben, pos, 1)) - 64) * 26 ^ (Len(Kennbuchstaben) - pos)
End If
Next pos
SpalteNr = temp
End Function

Private Function SpalteZeichen(Spalte As Integer) As String
If Spalten >= 26 Then
SpalteZeichen = Chr(64 + Int(Spalten / 26)) & Chr(65 + Spalten - Int(Spalten / 26) * 26)
Else
SpalteZeichen = Chr(65 + Spalten - Int(Spalten / 26) * 26)
End If
End Function

Ich möchte kostenlos eine Frage an die Mitglieder stellen:


Ähnliche Themen:


Suche in allen vorhandenen Beiträgen: