VBA Automatische Tabellenaktualisierung

[Maigooh]

Hallo liebe CB'ler,

bei einem Projekt gerate ich mit meinen VBA Kenntnissen an meine Grenzen.
Gewollt: Ein "Programm" in das ich eine Liste, welche eine Stückliste mit mehreren Daten zu jedem Teil besteht, einfüge und mit einer aktualisierten Liste mit gleichen Teilen, jedoch neuen Werten aktualisiere. Problem hierbei: Ein Teil ist über mehrere Spalten definiert also z.B. "492 32S 0A2 D", also habe ich hier meine Suchkriterien über mehrere Spalten verteilt. Natürlich sind die Teile auch nicht in derselben Reihenfolge dargestellt, daher auch der Abgleich.

Mein nächstes Problem wären die Spalten. Es kann der Fall eintreten, dass die Tabellen entweder um weitere Spalten erweitert wurde, welche jedoch zu ignorieren sind, also nicht mitübernommen werden sollen, oder die Spalten in einer unterschiedlichen Reihenfolge auftreten (jedoch gleich heißen)

Ich müsste also jede Zeile der neuen Tabelle nach den Teilbezeichnungen absuchen und zusätzlich nach der gewünschten Spalte, um gewollten neuen Wert in die alte Tabelle einfügen. Hierbei sollte natürlich nur dann ein Wert übertragen werden, wenn er ungleich dem alten Wert ist und falls er anders ist, soll er farblich markiert werden.

Was ich bisher habe:
Einen Inputtextbefehl mit dem man die zu aktualisierende Tabelle auswählen kann.
Einen Befehl, der die Tabelle kopiert und in eine neuerstellte Tabelle einfügt (nur bis zur letzt befüllten Zeile/Spalte).

Was mir fehlt:
Der oben beschriebene Abgleich.

Ich hoffe ich war einigermaßen verständlich und natürlich, dass ihr mir helfen könnt.

Liebe Grüße

 

[cumulonimbus8]

Mir fällt zu so was immer nur ein Wort ein: Datenbank.
Es ist nicht nötig mit VBA dieses Rad neu zu erfinden.

CN8

 

[Maigooh]

Ja leider geht es nicht anders als mit vba :/

 

[Quarzer]

Mach mal ein Screenshot davon. So kann man sich darunter leider wenig vorstellen. Mit Bildern ist das einfacher erklärt als mit Text.

 

[Maigooh]

Also Tabelle "Neue Tabelle" ist die zu aktualisierende Tabelle. Diese möchte ich mit den Werten aus "Aktuelle Tabelle" befüllen.
Hierbei stellen die Werte aus Spalte A beispielsweise die Bezeichnungen, also meine Suchkriterien ab. Da alles sehr universell sein soll,
fragt mein CODe ab nach:
Tabelle eingeben, welche die aktuellen Daten beinhaltet und von der kopiert werden soll
Spalte in der die Teilebezeichnungen stehen (A)
Zeile ab der die Bezeichnung beginnt (2)
Zeile in der Tabellenreiter, also A,B,C stehen (1)
Spalte ab der die Tabellenreiter beginnen (B)
Welche Spalten denn aktualisiert werden sollen
Anbei auch noch mein bisheriger Code, mit dem ich ein wenig verzweifle, da er je nachdem welche Tabelle offen ist, stellenweise funktioniert bzw. nicht.

   Sub Test()
Dim letzteSpalteO As Long
Dim letzteZeileO As Long
Dim letzteSpalteK As Long
Dim letzteZeileK As Long
Dim GefundenSpalte As Range
Dim GefundenZeile1 As Range
Dim GefundenZeile2 As Range
Dim GefundenZeile3 As Range
Dim GefundenZeile4 As Range
Dim GefundenZeile5 As Range
Dim GefundenZeile6 As Range
Dim GefundenZeile7 As Range
Dim GefundenZeile8 As Range
Dim A As Range
Dim B As Range
Dim C As Range
Dim D As Range
Dim E As Range
Dim F As Range
Dim G As Range
Dim H As Range

Dim Vergleichszeile As Long
Dim Vergleichsspalte As String
Dim BeginnVergleichsspalte As String
Dim BeginnVergleichszeile As String
Dim Spaltenauswahl1 As String
Dim Spaltenauswahl2 As String
Dim Spaltenauswahl3 As String
Dim Spaltenauswahl4 As String
Dim Spaltenauswahl5 As String
Dim Spaltenauswahl6 As String
Dim Spaltenauswahl7 As String
Dim Spaltenauswahl8 As String
Dim AktuelleTabelle
Dim Zeilennummer As Integer
Dim Spaltennummer As Integer

Dim SuchbereichTeile As Range
Dim SuchbereichAktuell As Range
Dim SuchbereichOriginal As Range
Dim SuchbereichTeileK As Range


AktuelleTabelle = InputBox("Wie heißt die Tabelle mit den aktuellen Daten?")
Vergleichsspalte = InputBox("Welche Spalte beinhaltet die Teilebezeichnungen?")
BeginnVergleichsspalte = InputBox("In Welcher Zeile beginnen die Teilebezeichnungen?")
Vergleichszeile = InputBox("In Welcher Zeile stehen die Tabellenreiter?")
BeginnVergleichszeile = InputBox("In welcher Spalte beginnen die Reiterbeschriftungen? (Bitte als Buchstabe)")
Spaltenauswahl1 = InputBox("Welche Spalten sollen aktualisiert werden? (Bitte als Buchstabe)")
    If Spaltenauswahl1 <> "" Then
        Spaltenauswahl2 = InputBox("Welche Spalten sollen aktualisiert werden? (Bitte als Buchstabe)")
        Else: End If
            If Spaltenauswahl2 <> "" Then
                Spaltenauswahl3 = InputBox("Welche Spalten sollen aktualisiert werden? (Bitte als Buchstabe)")
                 Else: End If
                    If Spaltenauswahl3 <> "" Then
                      Spaltenauswahl4 = InputBox("Welche Spalten sollen aktualisiert werden? (Bitte als Buchstabe)")
                       Else: End If
                        If Spaltenauswahl4 <> "" Then
                            Spaltenauswahl5 = InputBox("Welche Spalten sollen aktualisiert werden? (Bitte als Buchstabe)")
                             Else: End If
                             If Spaltenauswahl5 <> "" Then
                                Spaltenauswahl6 = InputBox("Welche Spalten sollen aktualisiert werden? (Bitte als Buchstabe)")
                                 Else: End If
                                    If Spaltenauswahl6 <> "" Then
                                        Spaltenauswahl7 = InputBox("Welche Spalten sollen aktualisiert werden? (Bitte als Buchstabe)")
                                         Else: End If
                                        If Spaltenauswahl7 <> "" Then
                                            Spaltenauswahl8 = InputBox("Welche Spalten sollen aktualisiert werden? (Bitte als Buchstabe)")
                                             Else: End If
                                                If Spaltenauswahl8 <> "" Then
                                                MsgBox ("Keine weiteren Werte mehr zufügbar!")
                                                End If
                                         
                                                
                    
                    
Spaltennummer = Range(Vergleichsspalte & 1).Column
With Sheets("Neues Blatt")
    Set SuchbereichTeile = Range(Vergleichsspalte & BeginnVergleichsspalte, Range(Vergleichsspalte & BeginnVergleichsspalte).End(xlDown))
    Set SuchbereichOriginal = Range(BeginnVergleichszeile & Vergleichszeile, Range(BeginnVergleichszeile & Vergleichszeile).End(xlToRight))
End With

With Sheets(AktuelleTabelle)
    Set SuchbereichAktuell = Range(BeginnVergleichszeile & Vergleichszeile, Range(BeginnVergleichszeile & Vergleichszeile).End(xlToRight))
    Set SuchbereichTeileK = Range(Vergleichsspalte & BeginnVergleichsspalte, Range(Vergleichsspalte & BeginnVergleichsspalte).End(xlDown))
End With


With Sheets("Neues Blatt")
letzteZeileO = Range("A65536").End(xlUp).Row
letzteSpalteO = UsedRange.Columns.Count
End With


With Sheets(AktuelleTabelle)
letzteZeileK = Range("A65536").End(xlUp).Row
letzteSpalteK = UsedRange.Columns.Count
End With



For I = BeginnVergleichsspalte To letzteZeileO

    If Sheets(AktuelleTabelle).Cells(I, Spaltennummer) <> "" Then

    Set GefundenSpalte = SuchbereichTeileK.Find(What:=Sheets("Neues Blatt").Cells(I, Spaltennummer).Value, lookat:=xlWhole)
    Set GefundenZeile1 = SuchbereichAktuell.Find(What:=Spaltenauswahl1, lookat:=xlWhole)
        MsgBox "Gefundenspalte" & GefundenSpalte.Column & GefundenSpalte.Row & "Gefundenzeile1" & GefundenZeile1.Column & GefundenZeile1.Row
        
  
    Set A = SuchbereichOriginal.Find(What:=Spaltenauswahl1, lookat:=xlWhole)
      
        MsgBox A.Column & A.Row
  
        Sheets(AktuelleTabelle).Range(Cells(GefundenSpalte.Row, GefundenZeile1.Column)).Copy
        Sheets("Neues Blatt").Range(Cells(GefundenSpalte.Row, A.Column)).Value.Paste
          
        
        If Spaltenauswahl2 <> "" Then
     Set GefundenZeile2 = SuchbereichAktuell.Find(What:=Spaltenauswahl2, lookat:=xlWhole)
               With Sheets(AktuelleTabelle)
            .Cells(GefundenSpalte.Row & ":" & GefundenZeile2.Column).Copy
            End With
        With Sheets("Neues Blatt")
    Set B = SuchbereichOriginal.Find(What:=Spaltenauswahl2, lookat:=xlWhole)
              .Cells(GefundenSpalte.Row & ":" & B.Column).Paste
              End With
         Else: End If
         
        If Spaltenauswahl3 <> "" Then
      Set GefundenZeile3 = SuchbereichAktuell.Find(What:=Spaltenauswahl3, lookat:=xlWhole)
             With Sheets(AktuelleTabelle)
            .Cells(GefundenSpalte.Row & ":" & GefundenZeile3.Column).Copy
            End With
        With Sheets("Neues Blatt")
    Set C = SuchbereichOriginal.Find(What:=Spaltenauswahl3, lookat:=xlWhole)
              .Cells(GefundenSpalte.Row & ":" & C.Column).Paste
              End With
        Else: End If
        
        If Spaltenauswahl4 <> "" Then
       Set GefundenZeile4 = SuchbereichAktuell.Find(What:=Spaltenauswahl4, lookat:=xlWhole)
               With Sheets(AktuelleTabelle)
            .Cells(GefundenSpalte.Row & ":" & GefundenZeile4.Column).Copy
            End With
        With Sheets("Neues Blatt")
    Set D = SuchbereichOriginal.Find(What:=Spaltenauswahl4, lookat:=xlWhole)
              .Cells(GefundenSpalte.Row & ":" & D.Column).Paste
              End With
         Else: End If
         
         If Spaltenauswahl5 <> "" Then
        Set GefundenZeile5 = SuchbereichAktuell.Find(What:=Spaltenauswahl5, lookat:=xlWhole)
                 With Sheets(AktuelleTabelle)
            .Cells(GefundenSpalte.Row & ":" & GefundenZeile5.Column).Copy
            End With
        With Sheets("Neues Blatt")
    Set E = SuchbereichOriginal.Find(What:=Spaltenauswahl5, lookat:=xlWhole)
              .Cells(GefundenSpalte.Row & ":" & E.Column).Paste
              End With
          Else: End If
          
          If Spaltenauswahl6 <> "" Then
         Set GefundenZeile6 = SuchbereichAktuell.Find(What:=Spaltenauswahl6, lookat:=xlWhole)
                  With Sheets(AktuelleTabelle)
            .Cells(GefundenSpalte.Row & ":" & GefundenZeile6.Column).Copy
            End With
        With Sheets("Neues Blatt")
    Set F = SuchbereichOriginal.Find(What:=Spaltenauswahl6, lookat:=xlWhole)
              .Cells(GefundenSpalte.Row & ":" & F.Column).Paste
              End With
           Else: End If
           
           If Spaltenauswahl7 <> "" Then
          Set GefundenZeile7 = SuchbereichAktuell.Find(Spaltenauswahl7, lookat:=xlWhole)
                   With Sheets(AktuelleTabelle)
            .Cells(GefundenSpalte.Row & ":" & GefundenZeile7.Column).Copy
            End With
        With Sheets("Neues Blatt")
    Set G = SuchbereichOriginal.Find(What:=Spaltenauswahl7, lookat:=xlWhole)
              .Cells(GefundenSpalte.Row & ":" & G.Column).Paste
              End With
              Else: End If
              
            If Spaltenauswahl8 <> "" Then
           Set GefundenZeile8 = SuchbereichAktuell.Find(What:=Spaltenauswahl8, lookat:=xlWhole)
                With Sheets(AktuelleTabelle)
            .Cells(GefundenSpalte.Row & ":" & GefundenZeile8.Column).Copy
            End With
        With Sheets("Neues Blatt")
    Set H = SuchbereichOriginal.Find(What:=Spaltenauswahl8, lookat:=xlWhole)
              .Cells(GefundenSpalte.Row & ":" & H.Column).Paste
              End With
         Else: End If
         
    End If
    Next I

End Sub

 

[Janush]

Und in die input box schreibst Du dann den Namen deiner Excel Tabelle rein? Ich habs mir nicht ganz durchgelesen, aber was passiert wenn Du da nen falschen Wert einträgst?

Scheib doch bitte nochmal auf was Du eigentlich erreichen willst. Am besten mit nem ordentlichen Screenshot....so steigt da ja keiner durch. Zumindest nicht ohne Aufwand ;-)

 

[Maigooh]

Hab es noch einmal ergänzt und jetzt sollte jede Inputboxabfrage in meinem Post beschrieben sein.
Im Endeffekt soll eine Liste mit vorhandenen Bauteilen und deren Daten (hier: Neues Blatt) aktualisiert werden. Diese "neuen Daten" stehen in einer anderen Tabelle (hier: Aktuelle Tabelle). Das Problem ist: in meinem Anwendungsfall kann es dazu kommen, dass die Liste mit den neuen Daten (Aktuelle Tabelle) nicht dieselbe Sortierung der Bauteilbezeichnungen hat, sowie auch eine andere Reihenfolge der Spalten. Ebenso kann es sein, dass neue Spalten hinzukommen, die wiederum interessieren nicht, es sollen nur die Spalten aktualisiert werden, die auch in der Ursprungsliste ("Neues Blatt") steht und die auch in die Inputbox eingegeben werden, da nicht immer alle Daten aus allen Spalten aktualisiert werden sollen.

ich wüsste nicht mit welchen Screenshots ich das noch deutlicher erklären könnte, außer euch die beiden Beispieltabellen zu zeigen.

 

[Janush]

Naja, zum Beispiel mit den original Tabellen, oder sind die vertraulich?

Und was soll am Ende aktualisiert werden? Doch bestimmt keines der Suchkriterien, oder?

 

[Maigooh]

zum einen habe ich sie nicht, und zum anderen sind sie vertraulich, ja

Ergänzung (2. Juli 2017)

ne die suchkriterien bleiben. Aus der aktuellen Tabelle sollen diese ganzen "4a","3c" Werte etc. in "Neues Blatt" kopiert werden.

Ergänzung (2. Juli 2017)

Bei der If-Schleife ab Zeile 107, bei der zum einen für jeden Zeileneintrag aus "Neues BLatt" (also die Teile) in "Aktuelle Tabelle" gesucht wird und anschließend für die Eingabe der zu aktualiserenden Spalte in "Aktuelle Tabelle" gesucht wird, bekomme ich nur ein Ergebnis, wenn ich diese Tabelle geöffnet habe. Habe versucht im Code vorher die Tabelle zu aktivieren, für den Fall, dass ich vorher dieses Blatt eben nicht geöffnet habe, dann spuckt er mir jedoch jedes mal Fehlermeldungen raus.

Ergänzung (2. Juli 2017)

habs hinbekommen, kann also geschlossen werden danke euch aber!