Wie eine neue Zeile einfügen in eine Auswahl und kopieren von Formeln

Ich habe einen benannten Bereich, wie die folgende Abdeckung A2:D3

ITEM    PRICE   QTY SUBTOTAL
1           10  3   30
1           5   2   10
           TOTAL:   40

Ich bin eine neue Zeile eingefügt mit VBA in den Bereich kopieren, werden die Formeln nicht Werten.

Irgendwelche Tipps/links sehr dankbar.

Kopie aus wo
Es ist egal, in welche Zeile, die Sie kopieren aus? Ich nehme an, wenn wir die Zeile einzufügen unmittelbar vor der total-und verwenden Sie die Formeln aus der Zeile darüber, dass für Sie arbeiten würde?

InformationsquelleAutor Chev | 2010-04-11

11

Dies sollte es tun:
```
Private Sub newRow(Optional line As Integer = -1)
Dim target As Range
Dim cell As Range
Dim rowNr As Integer

    Set target = Range("A2:D3")

    If line <> -1 Then
        rowNr = line
    Else
        rowNr = target.Rows.Count
    End If

    target.Rows(rowNr + 1).Insert
    target.Rows(rowNr).Copy target.Rows(rowNr + 1)
    For Each cell In target.Rows(rowNr + 1).Cells
        If Left(cell.Formula, 1) <> "=" Then cell.Clear
    Next cell
End Sub
```
- target.Rows(rowNr + 1).Insert: 1) nicht verlängern, der Benannte Bereich durch eine Zeile (AFAIK die einzige Art und Weise zu tun, so dass implizit mit Zeile Einfügen (vs. explizit ändern Range-definition) und so zu tun nachdem, die Zeile # ist über der Zeile #'s 1 bis Count - 1) und 2) nur die Verschiebungen von Spalten in der target Bereich nach unten durch eine Zeile. In vielen (wahrscheinlich den meisten) Fällen, Spalten rechts und/oder Links von der target Bereich müssen verschoben werden, unten auch. 3) target.Rows(rowNr).Copy target.Rows(rowNr + 1) kopiert nicht die Formate, die oft, wenn nicht meist gewünschten auch. Siehe meine Alternative Antwort unten.
InformationsquelleAutor marg
4

Wenn Sie die Aufnahme starten ein makro und eigentlich die Aufgabe in der hand, es wird den code für Sie generieren. Sobald Sie fertig sind, beenden Sie die Makroaufzeichnung und Sie haben den code erforderlich, die Sie dann ändern können.

InformationsquelleAutor Neil Knight
1

Diese sollten dir helfen: http://www.mvps.org/dmcritchie/excel/insrtrow.htm

InformationsquelleAutor user183037

Musste ich roll eine Lösung, die funktionierte wie die Möglichkeit einer Datenverbindung Abfrage wird eine Ergebnis-Bereich mit wahlweise autofilling Formeln nach rechts ab. Vielleicht zwei Jahre zu spät für die Prämie, aber ich bin glücklich zu teilen, eh!

Public Sub RangeExpand(rangeToExpand As Range, expandAfterLine As Integer, Optional linesToInsert As Integer = 1, Optional stuffOnTheRight As Boolean = False)
    Debug.Assert rangeToExpand.Rows.Count > 1
    Debug.Assert expandAfterLine < rangeToExpand.Rows.Count
    Debug.Assert expandAfterLine > 0

    If linesToInsert = 0 Then Exit Sub
    Debug.Assert linesToInsert > 0

    Do
        rangeToExpand.EntireRow(expandAfterLine + 1).Insert
        linesToInsert = linesToInsert - 1
    Loop Until linesToInsert <= 0

    If stuffOnTheRight Then
        rangeToExpand.Item(expandAfterLine, rangeToExpand.Columns.Count + 1).Select
        Range(Selection, Selection.End(xlToRight)).Select
        Range(rangeToExpand.Item(expandAfterLine, 1), Selection).Select
    Else
        Range(rangeToExpand.Item(expandAfterLine, 1), rangeToExpand.Item(expandAfterLine, rangeToExpand.Columns.Count)).Select
    End If
    Selection.AutoFill Destination:=Range(rangeToExpand.Item(expandAfterLine, 1), rangeToExpand.Item(rangeToExpand.Rows.Count, Selection.Columns.Count))
End Sub

InformationsquelleAutor

1

Diese Antwort behebt die folgenden 3 Probleme bei der derzeit Akzeptierte Antwort von @marg Zitat Apr 13 '10 um 9:43.
1. target.Rows(rowNr + 1).Insert: 1.1. verlängert nicht die Benannten Bereich, durch die eine Reihe (AFAIK die einzige Art und Weise zu tun, so dass implizit mit Zeile Einfügen (vs. explizit ändern Range-definition) und so zu tun nach angegebene Zeile # ist über der Zeile #'s 1 bis Count - 1) und 1.2) nur die Verschiebungen von Spalten in der target Bereich nach unten durch eine Zeile. In vielen (wahrscheinlich den meisten) Fällen, Spalten rechts und/oder Links von der target Bereich müssen verschoben werden, unten auch.
2. target.Rows(rowNr).Copy target.Rows(rowNr + 1) nicht kopieren
  die Formate, die oft, wenn nicht meist gewünschten auch.
Private Sub InsertNewRowInRange( _
TargetRange As Range, _
Optional InsertAfterRowNumber As Integer = -1, _
Optional InsertEntireSheetRow As Boolean = True)
```
' -- InsertAfterRowNumber must be 1 to TargetRange.Rows.Count - 1 for TargetRange to be extended by one Row and for there to be
' --    Formats and Formulas to copy from (e.g. can't be 0).  Default: If -1, defaults to TargetRange.Rows.Count.
' --    Recommend dummy spacer Row at the bottom of TargetRange which, btw, would also be necessary to manually extend a Range
' --    by one Row implicitly via Insert Row (vs. explicilty via changing Range definition).

        If InsertAfterRowNumber = -1 Then
            InsertAfterRowNumber = TargetRange.Rows.Count
        End If

        If InsertEntireSheetRow Then
            TargetRange.Cells(InsertAfterRowNumber + 1, 1).Select
            Selection.EntireRow.Insert
        Else
            TargetRange.Rows(InsertAfterRowNumber + 1).Insert
        End If

        TargetRange.Rows(InsertAfterRowNumber).Select
        Selection.Copy

        TargetRange.Rows(InsertAfterRowNumber + 1).Select
        Selection.PasteSpecial _
            Paste:=xlPasteFormats, _
            Operation:=xlNone, _
            SkipBlanks:=False, _
            Transpose:=False
        Selection.PasteSpecial _
            Paste:=xlPasteFormulas, _
            Operation:=xlNone, _
            SkipBlanks:=False, _
            Transpose:=False

        Application.CutCopyMode = False

    End Sub
```
- Ich habe diesen code. Es erfüllt meine Anforderung und arbeitete wie ein Charme. Aber plötzlich begann ich immer Run-time error '1004'. Insert-Methode des Range-Klasse ist fehlgeschlagen. in der Zeile TargetRange.Rows(InsertAfterRowNumber + 1).Insert. Er arbeitete für einige Tage und dann plötzlich begann ich immer diese Fehlermeldung.
- Gerade gesehen, das. Was ist die aktuelle definition von TargetRange und was sind die Parameter, die Sie übergeben?
- Eigentlich ist mein Blatt geschützt war, die verursachen bei mir das Problem. Aufheben des Schutzes Sie haben die Arbeit für mich. Trotzdem danke für die große Lösung.
- Sie sind herzlich willkommen! Btw, man kann auch danke von mir, Bis die Abstimmung meine Antwort, wenn Sie nicht bereits getan haben. 😉
InformationsquelleAutor Tom

Hier ist eine andere Lösung, die aufbauend auf die Antwort von @Tom. Es verwendet nicht die "Auswahl", und es ist möglich, mehrere Zeilen einfügen.

' Appends one or more rows to a range.
' You can choose if you want to keep formulas and if you want to insert entire sheet rows.
Private Sub expand_range( _
                        target_range As Range, _
                        Optional num_rows As Integer = 1, _
                        Optional insert_entire_sheet_row As Boolean = False, _
                        Optional keep_formulas As Boolean = False _
                        )

    Application.ScreenUpdating = False
    On Error GoTo Cleanup

    Dim original_cell As Range: Set original_cell = ActiveCell
    Dim last_row As Range: Set last_row = target_range.Rows(target_range.Rows.Count)

    ' Insert new row(s) above the last row and copy contents from last row to the new one(s)
    IIf(insert_entire_sheet_row, last_row.Cells(1).EntireRow, last_row) _
        .Resize(num_rows).Insert Shift:=xlShiftDown, CopyOrigin:=xlFormatFromRightOrBelow
    last_row.Copy
    last_row.Offset(-num_rows).PasteSpecial
    last_row.ClearContents

    On Error Resume Next ' This will fail if there are no formulas and keep_formulas = True
        If keep_formulas Then
            With last_row.Offset(-num_rows).SpecialCells(xlCellTypeFormulas)
                .Copy
                .Offset(1).Resize(num_rows).PasteSpecial
            End With
        End If
    On Error GoTo Cleanup

Cleanup:
    On Error GoTo 0
    Application.ScreenUpdating = True
    Application.CutCopyMode = False
    original_cell.Select
    If Err Then Err.Raise Err.Number, , Err.Description
End Sub

InformationsquelleAutor tomashm

Schreibe einen Kommentar

Du musst angemeldet sein, um einen Kommentar abzugeben.