Office: (Office 365) Daten in intelligenter Tabelle updaten

Hallo,
ich habe ein kurze intelligente Tabelle mit Formeln und Werten. In Spalte A steht eine eindeutige ID. In Spalte B bis Z dann die Formeln bzw. Werte.
Die Werte aus der kurzen Tabelle soll nun die lange Tabelle updaten.
Wenn die ID in beiden Tabellen vorhanden ist kopiere die Werte aus kurzer Tabelle in lange Tabelle. Wenn die ID in der langen Tabelle noch nicht vorhanden ist, kopieren die Daten an das End der langen Tabelle als neue Zeile.
Kann mir hierzu jemand weiterhelfen. Dank und Gruß

 

Vielleicht hätte ich noch schreiben sollen ob mir jemand beim VBA Code helfen kann.

For i = 1 bis ende Lange Tabelle

 

Hallo,

muss es denn wirklich VBA sein. Mit der in Excel vorhandenen Power Query (PQ) Funktionalität wären es nur einmalig ein paar Mausklicks.

 

Hallo neopa,

von PowerQuery habe ich noch weniger Ahnung als von VBA.
Ich habe die Sub schon fast fertig aber ein Problem habe ich immer noch.

Sub UpdateData ()

Dim TB1 As Worksheet, TB2 As Worksheet
Dim LR2 As Long, i As Long, Zeile As Long
Dim Z1 As Integer, SP As Integer

Set TB1 = Sheets("LangeTabelle")
Set TB2 = Sheets("KurzeTabelle")
Z1 = 6 'Erste Zeile mit Daten / wegen Überschrift
SP = 1 'Daten in A

LR2 = TB2.Cells(TB2.Rows.Count, SP).End(xlUp).Row 'letzte Zeile der Spalte

For i = Z1 To LR2
If WorksheetFunction.CountIf(TB1.Columns(SP), TB2.Cells(i, SP)) > 0 Then
'Schon vorhanden in Zeile
Zeile = WorksheetFunction.Match(TB2.Cells(i, SP), TB1.Columns(SP), 0)

Else
'Neu anlegen
Zeile = TB1.Cells(TB1.Rows.Count, SP).End(xlUp).Row + 1
End If

'Inhalt der Zeile kopieren
TB2.Rows(i).Copy
TB1.Rows(Zeile).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False

Next

Die "neuen" Zeilen werden zwar unten an die Tabelle geschrieben - aber die intelligente Tabelle wird um die Anzahl der neuen Zeilen nicht erweitert! :-(

Was fehlt oder ist falsch im Code??

Als VBA Neuling habe ich das Gefühl es gibt für jedes Problem unterschiedlich Befehle je nachdem ob es ein neue "intelligente" Tabelle ist oder eine "normale" Tabelle - das macht es nicht gerade einfach!

 

Hallo,

Code:

Option Explicit

Sub UpdateData()

   Dim TB1 As Worksheet, TB2 As Worksheet
   Dim lst1 As ListObject, lst2 As ListObject
   Dim row1 As ListRow, row2 As ListRow
   Dim valID As Variant, rngID1 As Range, Idx1 As Long, Sp1 As Long
  
   Set TB1 = Sheets("LangeTabelle"): Set lst1 = TB1.ListObjects("LangeStrukTabelle")  '<== Anpassen!
   Set TB2 = Sheets("KurzeTabelle"): Set lst2 = TB2.ListObjects("KurzeStrukTabelle")   '<== Anpassen!
  
   For Each row2 In lst2.ListRows
      valID = row2.Range.Cells(1)
      Set rngID1 = lst1.ListColumns("ID").DataBodyRange.Find(What:=valID, LookIn:=xlValues, LookAt:=xlWhole)
      If rngID1 Is Nothing Then
         'ID wurde nicht gefunden: Satz der Kurztabelle an Langtabelle anfügen
         Set row1 = lst1.ListRows.Add
      Else
         'ID wurde gefunden: Diesen Satz updaten
         Idx1 = rngID1.Row - lst1.HeaderRowRange.Row
         Set row1 = lst1.ListRows(Idx1)
      End If
      row2.Range.Copy Destination:=row1.Range
   Next row2
  
End Sub

Die Namen der Arbeitsblätter und der Tabellen sind noch anzupassen. Es wird angenommen, dass beide Tabellen gleich viele Spalten besitzen.

 

Hallo Exl121150,

vielen Dank. Funktioniert so weit bis auf das die Formeln aus der kurzen Tabelle kopiert werden und leider nicht die "Werte"

Wie muss hierzu die folgende Zeile abgeändert werden:
row2.Range.Copy Destination:=row1.Range

Dank und Gruß

 

Hi nochmal,
hab die Lösung in den Untiefen des Internets gefunden:

row2.Range.Copy
row1.Range.PasteSpecial Paste:=xlPasteValues

Nochmals Dank