Per VBA Befehl automatisch Zeilen einfügen

Hallo zusammen,

versuche mich an einem Makro, mit dem man automatisch Zellen einfügen kann. Wie man an dem ganzen sieht, immer noch im Anfängermodus...

Vorab noch eine kleine Funktionsbeschreibung:

In der Spalte C sind steht z.B. von C5-C25 der Wert 21, in der Spalte C26-C37 steht der Wert 34, etc.

Die Funktion soll so sein, dass zwischen C25 und C26 drei Zeilen eingefügt werden und die Formatierung gelöscht wird. Das ganze soll natürlich variabel sein, also Excel soll erkennen, wenn die Zellen unterschiedlich sind und dann die Zeilen einfügen.

Bin ich mit dem u.g. Ansatz auf dem richtigen (Holz-) Weg?

Code:

Sub Zeilen_einfuegen()
Dim r As Integer
    For r = 1 To r = 1500
        If Cells(3, r) <> Cells(3, r + 1) Then
            Rows.Select
                Selection.Insert Shift:=xlDown
                Selection.Borders(xlDiagonalDown).LineStyle = xlNone
                Selection.Borders(xlDiagonalUp).LineStyle = xlNone
                Selection.Borders(xlEdgeLeft).LineStyle = xlNone
                Selection.Borders(xlEdgeTop).LineStyle = xlNone
                Selection.Borders(xlEdgeBottom).LineStyle = xlNone
                Selection.Borders(xlEdgeRight).LineStyle = xlNone
                Selection.Borders(xlInsideVertical).LineStyle = xlNone
                Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
                Selection.Interior.ColorIndex = xlNone
        End If
    Next r
End Sub

 

Also ich würd's so schreiben!

Sub Zeilen_einfuegen()
Dim r As Integer
For r = 1 To 1500
If Cells(3, r) <> Cells(3, r + 1) Then

Rows(r).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
Rows(r).ClearFormats
Rows(r).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
Rows(r).ClearFormats
Rows(r).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
Rows(r).ClearFormats

End If
Next r
End Sub

 

Hi Manne, danke dir.

Habs ausprobiert, klappt aber nicht. Habe aber für den Lerneffekt erst mal die Formatierung weggelassen, sondern dachte ich versuche nun erstmal die Zellen einzufügen - nach deinem Post ist das daraus geworden:

Code:

Sub Zeilen_einfuegen()
Dim r As Integer
For r = 6 To r = 1500
If Cells(r, 3) <> Cells(r + 1, 3) Then
Rows("r:r").Select
Selection.Insert Shift:=xlDown
Selection.Insert Shift:=xlDown
Selection.Insert Shift:=xlDown
End If
Next r
End Sub

Aber scheinbar steuert er die Reihen gar nicht an. Woran kann das liegen?

 

Was meinst du damit? Welche Excel-version hast du?

 

Hi Manne, ich nutze Excel 2003. Es scheint so, als ob Excel gar nicht an den Punkt Rows.Select kommt. Wenn ich wissen will, ob Zelle C14<>C15 ist, heißt dies doch Cells(14,3)<>Cells(15,3) oder? Vielen Dank in jedem Fall für deine Hilfe und viele Grüße

 

Was sagt den der Debugger im Einzelschritt (F8) ?

Hier meckert er nicht:
For r = 6 To r = 1500 ?

"For-Next-Schleifen sind abweisend.
Es wird vor dem ersten Schleifendurchgang geprüft, ob die Bedingungen sinnvoll sind."
Quelle: http://www.amazon.de/programmieren-...5301/ref=sr_1_1?ie=UTF8&qid=1294664994&sr=8-1

 

Hi chipchap, doch da hat er gemeckert ... danke für den Tip Allerdings habe ich nun folgendes Problem - wie sage ich dem Programm, dass es nachdem die Zeile eingefügt wurde von dieser Stelle aus weiter prüfen soll. Akutell fügt er beim ersten ungleich solange Zeilen ein bis die Schleife zu Ende ist. Wäre "And" bzw. "Goto" ein richtiger Ansatz?

Hier mein Schnippsel:

Code:

Sub Zeilen_einfuegen()
Dim r As Integer
For r = 6 To 150
If Cells(r, 3) <> Cells(r + 1, 3) Then
Rows(r + 1).Select
Selection.Insert Shift:=xlDown
End If
Next r
End Sub

 

Okay, ich muss die Frage kurz umformulieren:

Wie schaffe ich es, dass die Schleife bei r+1 fortgeführt wird, wenn Cells (r,3)<>Cells(r+1,3)? Kann mir dabei einer helfen?


Sub Zeilen_einfuegen()
Dim r As Integer
For r = 6 To 150
If Cells(r, 3) <> Cells(r + 1, 3) Then
Rows(r + 1).Select
Selection.Insert Shift:=xlDown
-----------hier müsste der Sprungbefehl hin, von dem ich nicht weiß wie er heißt
End If
Next r
----------hier dann die Marke, wo hingesprungen wird
Next r+1
End Sub

 

GOTO - der Tod jeglicher Übersichtlichkeit - ist mit Recht aus VBA verbannt.
Subroutinen werden mit dem Routinennamen aufgerufen.
Allerdings können sie keine Variable übergeben.
Dafür braucht man Funktionen.

Das machst Du doch, oder nicht?


Ansonsten müßte ELSE helfen:

Sub Zeilen_einfuegen()
Dim r As Integer
For r = 6 To 150
If Cells(r, 3) <> Cells(r + 1, 3) Then
Rows(r+1).Select
Selection.Insert Shift:=xlDown
ELSE
r = r+1
End If
Next

End Sub

Wie lange programmierst Du schon Excel?
Welche Literatur verwendest Du?

 

Warum nicht einfach so ....


Dim r As Integer

For r = 6 To 150
If Cells(r, 3) <> Cells(r + 1, 3) Then
Rows(r + 1).Insert Shift:=xlDown
Rows(r + 1).Insert Shift:=xlDown
Rows(r + 1).Insert Shift:=xlDown
r = r + 3
End If
Next r

 

bzw hier werden jetzt die Formate noch gelöscht!


Dim r As Integer

For r = 6 To 150
If Cells(r, 3) <> Cells(r + 1, 3) Then
Rows(r + 1).Insert Shift:=xlDown
Rows(r + 1).ClearFormats
Rows(r + 1).Insert Shift:=xlDown
Rows(r + 1).ClearFormats
Rows(r + 1).Insert Shift:=xlDown
Rows(r + 1).ClearFormats
r = r + 3
End If
Next r

 

Hallo ihr beiden und vielen Dank noch einmal für eure Hilfe. Tut mir leid, dass ich mich jetzt erst wieder melde.

Vielleicht noch kurz zu meiner Literatur: Held - Excel VBA in 14 Tagen - und google

Was ich an dem obigen Code aber noch nicht verstanden habe ist das r=r+3 - wieso funktioniert das? Nach meine Verständnis müsste Excel doch dennoch mit dem folgenden r weitermachen, oder nicht?

Viele Grüße und schönes Wochenende