Suche Lösung in VBA

[ToXiC]

Ich habe eben mit dem Chef gesprochen. Eine Sicherheitsabfrage möchte er nicht.
Er hätte dafür gerne, dass man im Bereich unter Arbeitsschritte/ Aktivitäten nicht nur am Ende, sondern auch dazwischen Zeilen einfügen kann.
Natürlich mit Formelübertragung.

Außerdem ist aufgefallen, dass sich in diesem Bereich die Eingaben bei H:I nicht linksbündig ausrichten, selbst bei manueller Ausrichtung nicht.
Ich weiß aber nicht, woran es liegt...

[Rabe]

Hi,

1.) Ich habe eben mit dem Chef gesprochen. Eine Sicherheitsabfrage möchte er nicht.
2.) Er hätte dafür gerne, dass man im Bereich unter Arbeitsschritte/ Aktivitäten nicht nur am Ende, sondern auch dazwischen Zeilen einfügen kann.
Natürlich mit Formelübertragung.
3.) Außerdem ist aufgefallen, dass sich in diesem Bereich die Eingaben bei H:I nicht linksbündig ausrichten, selbst bei manueller Ausrichtung nicht.
Ich weiß aber nicht, woran es liegt...

Bitte beachten: Du kannst nicht einfach ohne Veränderung der Makros (zusätzliche) Spalten oder Zeilen einfügen oder löschen!

zu 1) dann muß aber klar sein: wenn der Cursor in einer Zelle im oberen Bereich steht und der Benutzer drückt auf den Button mit der roten Schrift, dann ist die komplette Zeile unwiederbringlich weg und alle Makros stimmen nicht mehr, da sie sich auf die fest verdrahteten Bereich beziehen.
Überlegung:
Evtl. könnte das Makro auf den Bereich ab Zeile 24 beschränkt werden, durch Abfrage der aktuellen Zeile und Überprüfung, ob sie sich im Bereich 24 bis eine Zeile vor "Summe:" befindet, erst dann die Zeile löschen.
[edit]
Siehe Makro: "ZwischenZeileEinfügen()"

zu 2.)
nimm mal das zweite Makro und weise es einem neuen Button "Zeile unterhalb einfügen" zu, es wird die Formel in A und in C von einer Zeile drüber kopiert:
Welche Formel soll übertragen werden?

Hier die Makros:

Option Explicit

Sub Zeile_einfügen()    'Zeile am Ende des Blocks einfügen 
  ' 
  ' © by Rabe of Clever-Excel-Forum.de 
  '     2016-06-23 
  ' 
  Dim loZeile As Long
  ' 
  loZeile = 1000
  loZeile = Application.WorksheetFunction.Match("Summe:", Range("B24:B" & loZeile), 0) ' gibt Zeile im Suchbereich aus 
  loZeile = 24 + loZeile - 1           'Addition der Such-Startzeile, => Zeile der letzten Datenzeile vor "Summe:" 
  '   MsgBox loZeile                   'Anzeige der Zahl zu Testzwecken 
  
  ActiveSheet.Unprotect Password:="PW"
  Application.EnableEvents = False
  
  Rows(loZeile & ":" & loZeile).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
  Range("B" & loZeile).FormulaR1C1 = "=ROW()-23"
  Range("C" & loZeile).Select
  Range("B" & loZeile - 1 & ":I" & loZeile - 1).Copy Range("B" & loZeile)
  Range("C" & loZeile & ":I" & loZeile).ClearContents
  Range("G" & loZeile + 1).Formula = "=Sum(G24:G" & loZeile & ")"
  Range("H" & loZeile + 1).Formula = "=Sum(H24:H" & loZeile & ")"
  Range("I" & loZeile + 1).Formula = "=Sum(I24:I" & loZeile & ")"
  
  Application.EnableEvents = True
  '   ActiveSheet.Protect Password:="PW", AllowInsertingRows:=True, AllowDeletingRows:=True, AllowFormattingCells:=True 
End Sub

Sub ZwischenZeileEinfügen()    'Zeile unterhalb der aktuellen Zeile einfügen 
  ' 
  ' © by Rabe of Clever-Excel-Forum.de 
  '     2016-06-23 
  ' 
  Dim loZeile As Long
  ' 
  
  loZeile = ActiveCell.Row
  '   ActiveCell.EntireRow.Insert 
  Rows(loZeile + 1 & ":" & loZeile + 1).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
  Range("B" & loZeile - 1).Copy Range("B" & loZeile + 1)
  '  Range("C" & loZeile - 1).Copy Range("C" & loZeile + 1) 
  Range("C" & loZeile + 1).Select
  Application.CutCopyMode = False
End Sub

Sub Zeile_löschen()              'aktuelle Zeile löschen 
  ' 
  ' © by Rabe of Clever-Excel-Forum.de 
  '     2016-06-23 
  ' 
  Dim LöschZeile As Range
  Dim loZeile As Long
  ' 
  loZeile = 1000
  loZeile = Application.WorksheetFunction.Match("Summe:", Range("B24:B" & loZeile), 0) ' gibt Zeile im Suchbereich aus 
  loZeile = 24 + loZeile - 2           'Addition der Such-Startzeile, => Zeile der letzten Datenzeile vor "Summe:" 
  '   MsgBox loZeile                   'Anzeige der Zahl zu Testzwecken 
  
  ActiveSheet.Unprotect Password:="PW"
  Application.EnableEvents = False
  
  If Not Intersect(Rows(ActiveCell.Row), Rows("24:" & loZeile)) Is Nothing Then
     ActiveCell.EntireRow.Delete          'löschen der aktuellen Zeile, wirkt aber im gesamten Blatt! 
  End If
  
  Application.EnableEvents = True
  '   ActiveSheet.Protect Password:="PW", AllowInsertingRows:=True, AllowDeletingRows:=True, AllowFormattingCells:=True 
  
End Sub

Sub letzte_Zeile_löschen()
  ' 
  ' © by Rabe of Clever-Excel-Forum.de 
  '     2016-06-23 
  ' 
  Dim loZeile As Long
  ' 
  loZeile = 1000
  loZeile = Application.WorksheetFunction.Match("Summe:", Range("B24:B" & loZeile), 0) ' gibt Zeile im Suchbereich aus 
  loZeile = 24 + loZeile - 2           'Addition der Such-Startzeile, => Zeile der letzten Datenzeile vor "Summe:" 
  '   MsgBox loZeile                   'Anzeige der Zahl zu Testzwecken 
  
  ActiveSheet.Unprotect Password:="PW"
  Application.EnableEvents = False
  
  Rows(loZeile).EntireRow.Delete       'löschen der letzten Zeile 
  
  Application.EnableEvents = True
  '   ActiveSheet.Protect Password:="PW", AllowInsertingRows:=True, AllowDeletingRows:=True, AllowFormattingCells:=True 
End Sub

zu 3.) das muß getestet werden. Da komme ich gerade nicht dazu.

Eigentlich können nun die Buttons "Zeile einfügen" und "letzte Zeile löschen" entfernt werden, die und die dazugehörigen Malros werden nicht mehr benötigt.
   

[ToXiC]

Hi,

der Button Zeile löschen (gesamtes Arbeitsblatt) wird sowieso entfernt, den zugehörigen Code-Abschnitt werde ich temporär deaktivieren.
Mit Formeln meinte ich, dass unten die Summenformel sowie die automatische Nummerierung weiterhin funktionieren sollen.

Ich habe den den Code ZwischenZeileEinfügen übernommen und versuche ihn zu optimieren.
Der Code beinhaltet nicht, dass verbundene Zellen verbunden kopiert werden. Nach Drücken des Buttons, fügt er nur eine neue Zeile ein.
Die Funktion Zwischenzeile einfügen soll nur im Bereich gelten, wo auch zuvor die Zeilen eingefügt und gelöscht werden konnten.
Nur eben, dass sich die Zeile nicht nur am Ende einfügen lässt, sondern dazwischen.

Wenn ich die Zeile unter der Überschriften-Zeile "Arbeitsschritte/ Aktivitäten" einfüge, wird die Überschriften-Zeile kopiert, nicht aber die der Laufenden Nummer.

Das Problem mit der Linksbündigkeit konnte ich ganz einfach lösen: Ich habe einfach die Zellen G24-G33 kopiert und in H und I eingefügt. Scheinbar hatten die Zellen einen Schaden .
Edit: Hier noch einmal der Ausschnitt, wo dann nach Wunsch eine Zeile (Kopie) eingefügt oder bei Bedarf gelöscht werden können soll, wenn und aber :

Deckblatt

	B	C	D	E	F	G	H	I
23	Lfd-Nr.	Arbeitsschritte/ Aktivitäten		Verantwortlich	Mitwirkende	Aufwand in Projekttagen	Ext. Kosten	Invest
24	1
25	2
26	3
27	4
28	5
29	6
30	7
31	8
32	9
33	10

Excel Tabellen im Web darstellen >> Excel Jeanie HTML 4.8

Wird unter laufender Nr. 1 eine Zeile eingefügt, dann soll nicht die Überschriftenleiste kopiert werden.

[Rabe]

Hi,

Wird unter laufender Nr. 1 eine Zeile eingefügt, dann soll nicht die Überschriftenleiste kopiert werden.

dann nimm diesen Code:

Sub ZwischenZeileEinfügen()    'Zeile unterhalb der aktuellen Zeile einfügen 
   ' 
   ' © by Rabe of Clever-Excel-Forum.de 
   '     2016-06-23 
   ' 
   Dim loZeile As Long
   ' 
   
   loZeile = ActiveCell.Row
   ActiveSheet.Unprotect Password:="PW"
   Application.EnableEvents = False
   
   If Not Intersect(Rows(ActiveCell.Row), Rows("24:" & loZeile)) Is Nothing Then
      '   ActiveCell.EntireRow.Insert 
      Rows(loZeile + 1 & ":" & loZeile + 1).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
      Range("B" & loZeile & ":J" & loZeile).Copy Range("B" & loZeile + 1)
      Range("C" & loZeile + 1).Select
   End If
   Application.CutCopyMode = False
   
   Application.EnableEvents = True
   '   ActiveSheet.Protect Password:="PW", AllowInsertingRows:=True, AllowDeletingRows:=True, AllowFormattingCells:=True 
End Sub

VBA/HTML - CodeConverter für Office-Foren, AddIn für Excel/Word 2000-2013 - komplett in VBA geschrieben von Lukas Mosimann. Projektbetreuung durch mumpel
Code erstellt und getestet in Office 15

Ich habe Deine andere Idee noch etwas weitergespielt, Formel für:
D13: =WENN($I$34<1;"wird automatisch ausgefüllt!";$I$34)
D14: =WENN($H$34<1;"wird automatisch ausgefüllt!";$H$34)

ich weiß nicht warum, aber es werden auch im oberen Bereich bis Zeile 23 Zeilen eingefügt. Das ist komisch, denn beim Löschen funktioniert es.
Ich hoffe, es kann noch jemand helfen!

[Kuwer]

Hi,

ich weiß nicht warum, aber es werden auch im oberen Bereich bis Zeile 23 Zeilen eingefügt. Das ist komisch, denn beim Löschen funktioniert es.
Ich hoffe, es kann noch jemand helfen!

   If loZeile > 23 Then

Gruß Uwe

[Rabe]

Hi Uwe,

  If loZeile > 23 Then

waaah, ich lach mich weg, soo einfach!
:79:  :85:
Danke!

Dann kann auch im Makro "aktuelleZeile_löschen" anstatt der "If Not Intersect ..."-Zeile folgende verwendet werden:

Code:

If ActiveCell.Row > 23 Then

[ToXiC]

Ich habe Deine andere Idee noch etwas weitergespielt, Formel für:
D13: =WENN($I$34<1;"wird automatisch ausgefüllt!";$I$34)
D14: =WENN($H$34<1;"wird automatisch ausgefüllt!";$H$34)

Das ist an sich super. Mein Chef wollte, dass es daneben steht, als Hinweis. Ich werde das aber nun einfach in D13 und D14 einfügen. Dann steht der Hinweistext dort, solange kein Betrag eingegeben wurde.
Die Formel werde ich mir morgen ansehen, bin zu müde.

Um 5:30 Uhr geht schon wieder der Wecker und ich werde alt

[ToXiC]

Hi Uwe,

  If loZeile > 23 Then

waaah, ich lach mich weg, soo einfach!
:79:  :85:
Danke!

Dann kann auch im Makro "aktuelleZeile_löschen" anstatt der "If Not Intersect ..."-Zeile folgende verwendet werden:

Code:

  If ActiveCell.Row > 23 Then

Ich verstehe es einfach nicht, wo soll das dann hin bzw. was wird damit ersetzt?

Edit: Ok, das habe ich nun hinbekommen.
Ich möchte nun aber, dass keine Zeilen eingefügt werden können ab "Summe:", also dies soll nur zwischen Überschriften- und Summen-Zeile möglich sein.

Edit 2: es sollen auch die Formeln mit kopiert werden, damit die Summenformel bei G, H, I auch weiterhin funktioniert.
Habe deshalb versucht, das aus einem anderen Code mit einzubinden, funktioniert aber nicht:

Code:

Sub ZwischenZeileEinfügen()
 
       ' Makro setzen für "Zeile unterhalb der aktuellen Zeile einfügen"
       Dim loZeile As Long
 
       ' Startpunkt ist aktive Zelle
       loZeile = ActiveCell.Row
       
       ' Blattschutz aufheben
       ActiveSheet.Unprotect Password:="PW"
       Application.EnableEvents = False
 
       ' Zeile einfügen nur ab > Zeile 23
  If loZeile > 23 Then
       ' Intersect(Rows(ActiveCell.Row), Rows("24:" & loZeile)) Is Nothing
       ' ActiveCell.EntireRow.Insert
       Rows(loZeile & ":" & loZeile).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
       Range("B" & loZeile).FormulaR1C1 = "=ROW()-23"
       Range("C" & loZeile).Select
       Range("B" & loZeile - 1 & ":I" & loZeile - 1).Copy Range("B" & loZeile)
       Range("C" & loZeile & ":I" & loZeile).ClearContents
       Range("G" & loZeile + 1).Formula = "=Sum(G24:G" & loZeile & ")"
       Range("H" & loZeile + 1).Formula = "=Sum(H24:H" & loZeile & ")"
       Range("I" & loZeile + 1).Formula = "=Sum(I24:I" & loZeile & ")"
       
  End If
       Application.CutCopyMode = False
       Application.EnableEvents = True
       
       ' Blattschutz setzen, Rechte vergeben
       ' ActiveSheet.Protect Password:="PW", AllowInsertingRows:=True, AllowDeletingRows:=True, AllowFormattingCells:=True
End Sub

Aktueller Stand:

[Rabe]

Hi,

Du brauchst jetzt nur noch diesen Code (alle anderen Makros in dem Modul löschen! Makro Worksheet_Change muß bleiben):

Option Explicit

Sub ZwischenZeileEinfügen()               ' Zeile unterhalb der aktuellen Zeile einfügen 
   ' 
   ' © by Rabe of Clever-Excel-Forum.de 
   '     2016-06-23 
   ' 
   ' benötigte Variablen definieren 
   Dim loZeile As Long                    ' Variable für aktuelle Zeile 
   Dim loSumme As Long                    ' Variable für Endzeile des Einfügebereiches 
   ' 
   ' ermitteln der Zeile, in der "Summe:" steht, zuweisen der Zeilenzahl-1 an Variable 
   loSumme = 1000
   loSumme = Application.WorksheetFunction.Match("Summe:", Range("B24:B" & loSumme), 0) ' gibt Zeile im Suchbereich aus 
   loSumme = 24 + loSumme - 1             ' Addition der Such-Startzeile, => Zeile der letzten Datenzeile vor "Summe:" 
   'MsgBox loSumme                         ' bei Bedarf aktivieren 
   
   ' Startpunkt ist aktive Zelle 
   loZeile = ActiveCell.Row
   
   ' Blattschutz aufheben 
   ActiveSheet.Unprotect Password:="PW"
   ' Ausschalten der Reaktion auf Änderungen während Makrolauf 
   Application.EnableEvents = False
   
   ' Zeile einfügen nur zwischen Zeile 24 und der Zeile mit "Summe:" 
   If loZeile > 23 And loZeile < loSumme Then
      'ActiveCell.EntireRow.Insert 
      Rows(loZeile + 1 & ":" & loZeile + 1).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
      Range("B" & loZeile & ":J" & loZeile).Copy Range("B" & loZeile + 1)
      Range("C" & loZeile + 1).Select
   End If
   Application.CutCopyMode = False
   
   ' Einschalten der Reaktion auf Änderungen während Makrolauf 
   Application.EnableEvents = True
   ' Blattschutz setzen 
   ' ActiveSheet.Protect Password:="PW", AllowInsertingRows:=True, AllowDeletingRows:=True, AllowFormattingCells:=True 
End Sub

Sub aktuelleZeile_löschen()               'aktuelle Zeile löschen 
   ' 
   ' © by Rabe of Clever-Excel-Forum.de 
   '     2016-06-23 
   ' 
   ' benötigte Variablen definieren 
   Dim loZeile As Long                    ' Variable für Endzeile des Löschbereiches 
   ' 
   ' ermitteln der Zeile, in der "Summe:" steht, zuweisen der Zeilenzahl-1 an Variable 
   loZeile = 1000
   loZeile = Application.WorksheetFunction.Match("Summe:", Range("B24:B" & loZeile), 0) ' gibt Zeile im Suchbereich aus 
   loZeile = 24 + loZeile - 1             ' Addition der Such-Startzeile, => Zeile der letzten Datenzeile vor "Summe:" 
   'MsgBox loSumme                         ' bei Bedarf aktivieren 
   
   ' Blattschutz aufheben 
   ActiveSheet.Unprotect Password:="PW"
   ' Ausschalten der Reaktion auf Änderungen während Makrolauf 
   Application.EnableEvents = False
   
   '   If Not Intersect(Rows(ActiveCell.Row), Rows("24:" & loZeile)) Is Nothing Then 
   If ActiveCell.Row > 23 And ActiveCell.Row < loZeile Then          ' Zeile löschen nur zwischen Zeile 24 und der Zeile mit "Summe:" 
      ActiveCell.EntireRow.Delete          'löschen der aktuellen Zeile 
   End If
   
   ' Einschalten der Reaktion auf Änderungen während Makrolauf 
   Application.EnableEvents = True
   ' Blattschutz setzen 
   ' ActiveSheet.Protect Password:="PW", AllowInsertingRows:=True, AllowDeletingRows:=True, AllowFormattingCells:=True 
   
End Sub

Die Zeilen werden nur zwischen Zeile 24 und SUMME: eingefügt und gelöscht, dadurch werden die Summenformeln automatisch angepaßt und müssen nicht neu reingeschrieben / reinkopiert werden.
Die Wiederholung der Zeilen für die Folgeseite habe ich auch gefunden!

  16-06-24-RDSb-V03-Arbeitspaket_roh_ohne_Bild.xlsm (Größe: 34,47 KB / Downloads: 1)

[ToXiC]

Wow, das ist ja wirklich toll. Ich würde aber gerne wissen, wie Du das mit dem Kopieren auf die nächste Seite gemacht hast.
da muss zwischen der Summen-Zeile und dem Unterschriften-Feld mindestens eine Leerzeile sein. Ich habe im Code nichts gefunden, was das Kopieren auf die nächste Seite angeht.

Am Liebsten hätte mein Chef gerne, dass das Unterschriften-Feld immer am Ende der Seite steht.

Die automatische Zeilenhöhe funktioniert irgendwie nicht richtig, wenn ich mehrere manuelle Zeilenumbrüche in die Zelle eingebe.
War zwar nur zu Testzwecken, aber sieht komisch aus:

   

Der aktuelle Stand DANK EUCH, besonders Ralf ebenfalls angehängt:


  16-06-24-RDSb-V02-Arbeitspaket.xlsm (Größe: 28,75 KB / Downloads: 1)