Microsoft Excel

Herbers Excel/VBA-Archiv

Informationen und Beispiele zum Thema MsgBox
BildScreenshot zu MsgBox MsgBox-Seite mit Beispielarbeitsmappe aufrufen

leere Zeile mit Text und Formel dynamisch einfügen | Herbers Excel-Forum


Betrifft: leere Zeile mit Text und Formel dynamisch einfügen von: christian
Geschrieben am: 28.11.2009 09:25:07

Hallo zusammen,
ich habe folgendes Problem das ich mit meinen wenigen VBA Kenntnissen nicht lösen kann.
Ich habe eine Tabelle mit n Zeilen.
- Nach jeweils ca. 53 Zeilen sollte eine Zeile mit dem Text "Zwischentotal " (Spalte C) und in die Summen-Formel für die 53 Zeilen (Spalte H) eingefügt bzw. gerechnet werden (im Register "Beschrieb" gelb markiert). Sollte die Zeile 53 nicht leer sein, soll das Makro weitersuchen bis es eine leere Zeile gefunden hat und dann obgenanntes einfügen.
- Diese Summe soll auf die nächste Seite übertragen (Spalte H) werden mit dem Text "Übertrag" (Spalte C).
https://www.herber.de/bbs/user/66242.zip

Ich habe einige Codebausteine hinterlegt...tja ich komm nicht weiter.

Vielen Dank für eure Hilfe
Gruss Christian

  

Betrifft: AW: leere Zeile mit Text und Formel dynamisch einfügen von: fcs
Geschrieben am: 28.11.2009 13:36:30

Hallo Christian,

das variable Einfügen von Seitenwechseln ist schon relativ komplex. Nachfolgend eine Prozedur die in deinem Blatt Seitenwechsel und Formelzeilen einfügt. Als Funktion hab ich dabei TEILERGEBNIS verwendet. Das hat den Vorteil, das die Formel immer ab Zeile J10 summieren kann und die Zwischensummen und Überträge auf den Seiten bei der Summenberechnung ausgeklammert werden.

Das Makro ist relativ langsam und braucht in deiner Datei bei mir (Notebook, Excel2007, Windows Vista 32 Bit, Pentium dual core T4200, 2 GHz, 4 GB Arbeitsspeicher) ca. 2 Sekunden pro Seite, um am Ende 27 Seiten aufzubereiten. Neben Arrayformeln ist das Auswerten und Einfügen von Seitenwechseln in größeren Dateien mit das rechenintensivste was Excel an VBA-Funktionen zu bieten hat. Vista setzt Excel während der Makroausführung manchmal sogar in den Status "Keine Rückmeldung" :-( , was ber nicht bedeutet, dass das Makro nicht mehr ausgeführt wird - es dauert halt einfach.

Gruß
Franz

Sub Seitenwechsel()
  Dim wks As Worksheet, ZeileLeer1 As Long, ZeileLeer2 As Long
  Dim ZeilePosition1 As Long, ZeilePosition2 As Long
  Dim Seitenwechsel As Long, StatusCalc As Long
  Dim LetzteZeile As Long, Zeile As Long
  Set wks = Worksheets("Beschrieb")
  With Application
    .ScreenUpdating = False
    StatusCalc = .Calculation
    .Calculation = xlManual
    .EnableEvents = False
  End With
  With wks
  'Alle Seitenwechsel löschen
  Application.StatusBar = "Seitenwechsel werden zurückgesetzt"
  wks.ResetAllPageBreaks
  LetzteZeile = .Cells(.Rows.Count, 3).End(xlUp).Row
  'Alle vorhandenen Zwischensummen und Übertragzeilen entfernen
  Application.StatusBar = "Zwischensummen und Übertragzeilen werden entfernt"
  For Zeile = LetzteZeile To 2 Step -1
    If .Cells(Zeile, 3).Value = "Zwischensumme" _
      Or .Cells(Zeile, 3).Value = "Übertrag" Then
      .Rows(Zeile).Delete shift:=xlShiftUp
    End If
  Next
  LetzteZeile = .Cells(.Rows.Count, 3).End(xlUp).Row
  Zeile = 5
  ZeileLeer1 = Zeile
  ZeileLeer2 = Zeile
  Do Until Zeile > LetzteZeile
    'Prüfen, ob Zelle in Spalte C (3) leer
    If .Cells(Zeile, 3) = "" Then
      ZeileLeer2 = ZeileLeer1 'vorherige leere Zeile merken
      ZeileLeer1 = Zeile 'letzte leere Zeile merken
    End If
    'Prüfen of Position in Spalte 2 wichtig, wenn keine Leerzeilen auf Seite
    If .Cells(Zeile, 2) <> "" Then
      ZeilePosition2 = ZeilePosition1 'vorherige Positionszeile merken
      ZeilePosition1 = Zeile 'letzte Positionszeile merken
    End If
    'Prüfen, ob automatischer Seitenwechsel in Zeile
    If .Cells(Zeile, 1).EntireRow.PageBreak = xlPageBreakAutomatic Then
      If Seitenwechsel < ZeileLeer1 Then
        'Seite enthält Leerzeilen - Seitenwechsel an Leerzeile einfügen
        If Zeile - ZeileLeer1 > 1 Then
          Zeile = ZeileLeer1 + 1
        Else
          Zeile = ZeileLeer2 + 1
        End If
        '2 Leerzeilen einfügen
        .Range(.Rows(Zeile), .Rows(Zeile + 1)).Insert shift:=xlShiftDown
      Else
        'keine Leerzeilen auf der Seite - Seitenwechsel an Positionsnummer einfügen
        If Zeile - ZeilePosition1 > 2 Then
          Zeile = ZeilePosition1
        Else
          Zeile = ZeilePosition2
        End If
        '3 Leerzeilen einfügen
        .Range(.Rows(Zeile), .Rows(Zeile + 2)).Insert shift:=xlShiftDown
        Zeile = Zeile + 1
      End If
      'Text und Formeln eintragen, Zeile fett formatieren
      .Cells(Zeile, 3).Value = "Zwischensumme"
      .Rows(Zeile).Font.Bold = True
      .Cells(Zeile, 10).FormulaR1C1 = "=SUBTOTAL(9,R6C10:R[-1]C)"
      .Cells(Zeile + 1, 3).Value = "Übertrag"
      .Rows(Zeile + 1).Font.Bold = True
      .Cells(Zeile + 1, 10).FormulaR1C1 = "=SUBTOTAL(9,R6C10:R[-1]C)"
      .Rows(Zeile + 1).PageBreak = xlPageBreakManual
      
      Seitenwechsel = Zeile + 1 'Position des Seitenwechsel merken
      LetzteZeile = .Cells(.Rows.Count, 3).End(xlUp).Row
      Application.StatusBar = "Zeile " & Zeile & " von " & LetzteZeile _
          & " abgearbeitet"
    End If
    Zeile = Zeile + 1
  Loop
  End With
  With Application
    .StatusBar = False
    .ScreenUpdating = True
    .Calculation = StatusCalc
    .EnableEvents = True
  End With
'  MsgBox "Fertig"
End Sub



  

Betrifft: AW: leere Zeile mit Text und Formel dynamisch einfügen von: christian
Geschrieben am: 28.11.2009 16:16:03

Hallo Franz,
was soll ich da noch sagen...einfach genial, ich hätte das niemals hinbekommen. Vielen herzlichen Dank!

Gruss Christian


Beiträge aus den Excel-Beispielen zum Thema "leere Zeile mit Text und Formel dynamisch einfügen"