Spalte in intelligenter Tabelle hinzufügen!

Hallo zusammen,

mal wieder muss ich die VBA Community um Hilfe bemühen.

Ich habe eine intelligente Tabelle mit dem Namen Preistabelle_Rohmaterial. In der ersten Spalte der Tabelle steht das "Preisdatum".
Immer wenn sich der Preis ändert, schreibt man hier das Datum und denn neuen Preis in Spalte 2 oder 3....

Was jetzt passieren soll:
Wenn ich in der Preistabelle_Rohmaterial eine neue Zeile (ein neues Datum) einfüge, dann soll sich automatisch eine andere intelligente Tabelle (Name der Tabelle: "Rohmaterial") um eine Spalte erweitern und das Datum welches in die Tabelle Preistabelle_Rohmaterial eingefügt wurde in die Kopzeile der Spalte eingetragen werden.
Die Spalte soll immer am Ende der Tabelle ("Rohmaterial") hinzugefügt werden. Alle Formeln die sich in den Zellen, der vorhergehenden Spalte befinden, sollten dann automatisch in die neue Spalte übernommen werden.

Sollte nun eine Zeile (ein Datum) aus der Tabelle "Preistabelle_Rohmaterial" gelöscht werden, dann sollte auch die entsprechende Spalte aus der Tabelle "Rohmaterial" entfernt werden.

Gibt es dazu eine Möglichkeit oder eine einfachere Lösung.

Hintergrund ist folgender: in der ersten Tabelle befinden sich reine Einkaufspreise in unterschiedlichen Mengeneinheiten, in der zweiten Tabelle werden die Mengeneinheiten dann in ein einheitliches Format umgewandelt um damit dann weiterzurechnen. Das Datum wird in späteren Rechnungen dazu genutzt um eine Zeitabhängigkeit in der Berechnung dar zu stellen.

Falls es jemanden gibt, der hier Hilfe leisten kann, würde ich mich sehr freuen.

Vielen lieben Dank und einen schönen Sonntag!

Viele Grüße
Stefan

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Option Explicit Dim lngDate As Long Private Sub Worksheet_Change(ByVal Target As Range) Dim intSpalte As Long Dim varDatum As Variant If Not Intersect(Target.Cells(1), ActiveSheet.ListObjects("Preistabelle_Rohmaterial").DataBodyRange.Columns(1)) Is Nothing Then If Target.Cells(1) = "" Then With ActiveSheet.ListObjects("Rohmaterial") For intSpalte = .ListColumns.Count To 7 Step -1 If CDate(.HeaderRowRange.Cells(intSpalte)) = CDate(lngDate) Then .ListColumns(intSpalte).Delete Exit Sub End If Next intSpalte End With Else With ActiveSheet.ListObjects("Rohmaterial") .ListColumns.Add Position:=.ListColumns.Count + 1 .HeaderRowRange.Cells(.HeaderRowRange.Cells.Count) = Target.Cells(1) Exit Sub End With End If End If End Sub Private Sub Worksheet_SelectionChange(ByVal Target As Range) If Not Intersect(Target.Cells(1), ActiveSheet.ListObjects("Preistabelle_Rohmaterial").DataBodyRange.Columns(1)) Is Nothing Then lngDate = Target.Cells(1) End If End Sub

With ActiveSheet.ListObjects("Rohmaterial") varDatum = Application.Match(Target.Cells(1), .HeaderRowRange, 0) If IsError(varDatum) Then Dim varStart As Variant '== diese Zeile kann an den Anfang der Prozedur verschoben werden .ListColumns.Add Position:=.ListColumns.Count + 1 .HeaderRowRange.Cells(.HeaderRowRange.Cells.Count) = Target.Cells(1) varStart = .HeaderRowRange.Cells(.HeaderRowRange.Cells.Count - 1) .DataBodyRange.Columns(.DataBodyRange.Columns.Count - 1).AutoFill _ Destination:=Range("Rohmaterial[[" & varStart & "]:[" & Target.Cells(1) & "]]"), Type:=xlFillDefault Exit Sub End If End With

Option Explicit Dim lngDate As Long Private Sub Worksheet_Change(ByVal Target As Range) Dim intSpalte As Long Dim varDatum As Variant Dim varStart As Variant If Not Intersect(Target.Cells(1), ActiveSheet.ListObjects("Preistabelle_Rohmaterial").DataBodyRange.Columns(1)) Is Nothing Then If Target.Cells(1) = "" Then With ActiveSheet.ListObjects("Rohmaterial") For intSpalte = .ListColumns.Count To 7 Step -1 If CDate(.HeaderRowRange.Cells(intSpalte)) = CDate(lngDate) Then .ListColumns(intSpalte).Delete Exit Sub End If Next intSpalte End With With ActiveSheet.ListObjects("Preis_final") For intSpalte = .ListColumns.Count To 3 Step -1 If CDate(.HeaderRowRange.Cells(intSpalte)) = CDate(lngDate) Then .ListColumns(intSpalte).Delete Exit Sub End If Next intSpalte End With Else With ActiveSheet.ListObjects("Rohmaterial") varDatum = Application.Match(Target.Cells(1), .HeaderRowRange, 0) If IsError(varDatum) Then .ListColumns.Add Position:=.ListColumns.Count + 1 .HeaderRowRange.Cells(.HeaderRowRange.Cells.Count) = Target.Cells(1) varStart = .HeaderRowRange.Cells(.HeaderRowRange.Cells.Count - 1) .DataBodyRange.Columns(.DataBodyRange.Columns.Count - 1).AutoFill _ Destination:=Range("Rohmaterial[[" & varStart & "]:[" & Target.Cells(1) & "]]"), Type:=xlFillDefault Exit Sub End If End With With ActiveSheet.ListObjects("Preis_final") varDatum = Application.Match(Target.Cells(1), .HeaderRowRange, 0) If IsError(varDatum) Then .ListColumns.Add Position:=.ListColumns.Count + 1 .HeaderRowRange.Cells(.HeaderRowRange.Cells.Count) = Target.Cells(1) varStart = .HeaderRowRange.Cells(.HeaderRowRange.Cells.Count - 1) .DataBodyRange.Columns(.DataBodyRange.Columns.Count - 1).AutoFill _ Destination:=Range("Preis_final[[" & varStart & "]:[" & Target.Cells(1) & "]]"), Type:=xlFillDefault Exit Sub End If End With End If End If End Sub Private Sub Worksheet_SelectionChange(ByVal Target As Range) If Not Intersect(Target.Cells(1), ActiveSheet.ListObjects("Preistabelle_Rohmaterial").DataBodyRange.Columns(1)) Is Nothing Then lngDate = Target.Cells(1) End If End Sub

Hi Stefan,

danke fürs Bereitsellen, allerdings wäre es günstiger gewesen, die Mappe mit allen 3 Tabellen zu sehen... ;-)

Ich habe den Code jetzt so geändert, dass beim Löschen 1 Spalte mit den Formeln übrig bleibt, sodass die tabelle sich entsprechend erweitern lässt. Die Überschrift der Spalte habe ich zu "Datum" festgelegt - wenn du etwas anderes möchtest dann an den 2 entsprechenden Stellen ändern.

Private Sub Worksheet_Change(ByVal Target As Range)

    Dim intSpalte As Long

    Dim varDatum As Variant

    Dim varStart As Variant

    If Not Intersect(Target.Cells(1), ActiveSheet.ListObjects("Preistabelle_Rohmaterial").DataBodyRange.Columns(1)) Is Nothing Then

        If Target.Cells(1) = "" Then

            With ActiveSheet.ListObjects("Rohmaterial")

                For intSpalte = .ListColumns.Count To 7 Step -1

                    If CDate(.HeaderRowRange.Cells(intSpalte)) = CDate(lngDate) Then

                        If .ListColumns.Count > 7 Then

                            .ListColumns(intSpalte).Delete

                            Exit For

                        Else

                            .HeaderRowRange.Cells(intSpalte) = "Datum"

                        End If

                    End If

                Next intSpalte

            End With

            With ActiveSheet.ListObjects("Preis_final")

                For intSpalte = .ListColumns.Count To 2 Step -1

                    If CDate(.HeaderRowRange.Cells(intSpalte)) = CDate(lngDate) Then

                        If .ListColumns.Count > 2 Then

                            .ListColumns(intSpalte).Delete

                            Exit For

                        Else

                            .HeaderRowRange.Cells(intSpalte) = "Datum"

                        End If

                    End If

                Next intSpalte

            End With

        Else

            If lngDate > Target.Cells(1) Then lngDate = Target.Cells(1)

            With ActiveSheet.ListObjects("Rohmaterial")

                varDatum = Application.Match(CStr(Target.Cells(1)), .HeaderRowRange, 0)

                If IsError(varDatum) Then

                    If Not IsNumeric(.HeaderRowRange.Cells(.HeaderRowRange.Cells.Count)) Then

                        .HeaderRowRange.Cells(.HeaderRowRange.Cells.Count) = CDate(lngDate)

                    Else

                        .ListColumns.Add Position:=.ListColumns.Count + 1

                        .HeaderRowRange.Cells(.HeaderRowRange.Cells.Count) = CDate(lngDate)

                        varStart = .HeaderRowRange.Cells(.HeaderRowRange.Cells.Count - 1)

                        .DataBodyRange.Columns(.DataBodyRange.Columns.Count - 1).AutoFill _

                            Destination:=Range("Rohmaterial[[" & varStart & "]:[" & CDate(lngDate) & "]]"), Type:=xlFillDefault

                    End If

                End If

            End With

            With ActiveSheet.ListObjects("Preis_final")

                varDatum = Application.Match(CStr(Target.Cells(1)), .HeaderRowRange, 0)

                If IsError(varDatum) Then

                    If Not IsNumeric(.HeaderRowRange.Cells(.HeaderRowRange.Cells.Count)) Then

                        .HeaderRowRange.Cells(.HeaderRowRange.Cells.Count) = CDate(lngDate)

                    Else

                        .ListColumns.Add Position:=.ListColumns.Count + 1

                        .HeaderRowRange.Cells(.HeaderRowRange.Cells.Count) = CDate(lngDate)

                        varStart = .HeaderRowRange.Cells(.HeaderRowRange.Cells.Count - 1)

                        .DataBodyRange.Columns(.DataBodyRange.Columns.Count - 1).AutoFill _

                            Destination:=Range("Preis_final[[" & varStart & "]:[" & CDate(lngDate) & "]]"), Type:=xlFillDefault

                    End If

                End If

            End With

        End If

    End If

End Sub

Bis später
Karin

Link zur Homepage: https://excel-inn.de/

Dim intAnzahl As Integer '== diese Zeile kann nach oben zu den anderen Variablendeklarationen verschoben werden With ActiveSheet.ListObjects("Rohmaterial") intAnzahl = Application.CountIf(.HeaderRowRange, "Endmaterial*") 'Anzahl ermitteln wie viele Spalten es für Endmaterial gibt For intSpalte = .ListColumns.Count To intAnzahl + 4 Step -1 If CDate(.HeaderRowRange.Cells(intSpalte)) = CDate(lngDate) Then If .ListColumns.Count > intAnzahl + 4 Then .ListColumns(intSpalte).Delete Exit For Else .HeaderRowRange.Cells(intSpalte) = "Datum" End If End If Next intSpalte End With

Option Explicit Private Sub Worksheet_Change(ByVal Target As Range) If Not Intersect(Target, ListObjects("Preistabelle_Rohmaterial").DataBodyRange) Is Nothing Then Application.EnableEvents = False With ListObjects("Preistabelle_Rohmaterial") If .Comment .ListRows.Count Then Erweitern .Comment = .ListRows.Count Else Entfernen .Comment = .ListRows.Count End If End With Application.EnableEvents = True End If End Sub

Option Explicit Sub Erweitern() With Tabelle1.ListObjects("Preistabelle_Rohmaterial").DataBodyRange Tabelle1.ListObjects("Rohmaterial").ListColumns.Add.Name = .Cells(.Rows.Count, 1) End With With Tabelle1.ListObjects("Rohmaterial").DataBodyRange .Columns(.Columns.Count - 1).AutoFill Destination:=Range(.Cells(1, .Columns.Count - 1), .Cells(3, .Columns.Count)), Type:=xlFillDefault End With End Sub Sub Entfernen() End Sub

Beliebteste Forumthreads (12 Monate)

Spalte in intelligenter Tabelle hinzufügen!

22
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Spalte in intelligenter Tabelle hinzufügen!

22 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

22
Beiträge zum Forumthread

Beiträge zu diesem Forumthread