Anzeige

VBA
Programmierer
gesucht?
 
Anzeige
VBA Programmierer gesucht?
 

VBA Codeschnipselsammlung

Eine zweite Tabelle mit neuen Einträgen einer anderen Tabelle ergänzen......

Folgende Situation: Sie haben eine Quell-Tabelle und möchten gerne alle Einträge (anhand einer ID Spalte zu erkennen), die nicht in der Ziel-Tabelle enthalten sind, dort ergänzend anhängen.

Zur Verdeutlichung einmal die Quell-Tabelle (Ausgangslage) und die gewünschte Ziel-Tabelle (vor und nach dem Makrodurchlauf).

Quell-Tabelle:

  A B C D E
 1  ID Spalte Text Zahl und weitere Spalten  
 2  1 Beispiel ABC 44 ...  
 3  2 Mustertext 66 ...  
 4  3 Neuer Eintrag 1 55 ...  
 5  4 Neuer Eintrag 2 21 ...  


Ziel-Tabelle (vorher):

  A B C D E
 1  ID Spalte Text Zahl und weitere Spalten  
 2  1 Beispiel ABC 44 ...  
 3  2 Mustertext 66 ...  
 4           
 5           


Und das Ergebnis nach dem Makrodurchlauf sollte so aussehen:

Ziel-Tabelle (nachher):

  A B C D E
 1  ID Spalte Text Zahl und weitere Spalten  
 2  1 Beispiel ABC 44 ...  
 3  2 Mustertext 66 ...  
 4  3 Neuer Eintrag 1 55 ...  
 5  4 Neuer Eintrag 2 21 ...  


Die letzen beiden Zeilen der Quell-Tabelle fehlen und werden durch das Makro in der Ziel-Tabelle ergänzt.

Für diese Ergänzungsaufgabe finden Sie folgend ein Beispielmakro:

Option Explicit
' ************************************************************************************************
' Autor/en: http://www.online-vba.de - Marc Wershoven
' Verwendung der Quelltexte auf eigene Gefahr!
' Es gelten die Nutzungsbedingungen von www.online-vba.de!
' Original-Quelltext: www.online-vba.de/vba_tabellen1.php
' ************************************************************************************************


Public Sub TabellenEintraegeErgaenzen()
   Dim lQuellZeile As Long
   Dim lZielZeile As Long
   Dim lSpalte As Long
   Dim lEinfuegeZeile As Long
   Dim oQuelle As Object
   Dim oZiel As Object
   Dim bFlag As Boolean
   Dim sVergleichQuelle As String
   Dim sVergleichZiel As String
  
     Set oQuelle = Sheets("Tabelle1")
     Set oZiel = Sheets("Tabelle2")
    
     Application.ScreenUpdating = False 'Flackern ausschalten
    
     'Ergänzung starten...
     For lQuellZeile = 2 To oQuelle.UsedRange.Rows.Count + oQuelle.UsedRange.Row - 1
    
         bFlag = False
       
         'Prüfen ob die ID schon in der Ziel-Tabelle vorhanden ist...
         For lSuchZeile = 2 To oZiel.UsedRange.Rows.Count + oZiel.UsedRange.Row - 1
            sVergleichQuelle = CStr(oQuelle.Cells(lQuellZeile, 1).Text)
            sVergleichZiel = CStr(oZiel.Cells(lSuchZeile, 1).Text)
            If LCase(Trim(CStr(sVergleichQuelle))) = LCase(Trim(CStr(sVergleichZiel))) Then
                 bFlag = True
                 Exit For
            End If
         Next lSuchZeile
       
         'Prüfergebnis entscheidet ob bereits vorhanden oder eine neue Zeile angelegt werden muss
         If bFlag = True Then
             'Bereits vorhanden
         Else
             'Zeile als neu unten anhängen
             lEinfuegeZeile = (oZiel.UsedRange.Rows.Count + oZiel.UsedRange.Row - 1) + 1
             For lSpalte = 1 To 4 'Spalten 1 bis 4 werden ohne Formate übertragen
                 oZiel.Cells(lEinfuegeZeile, lSpalte) = oQuelle.Cells(lQuellZeile, lSpalte)
             Next lSpalte
         End If
        
     Next lQuellZeile 'Nächsten Eintrag der Quell-Tabelle verarbeiten...
    
     'Aufräumen
     Application.ScreenUpdating = True
     Set oZiel = Nothing
     Set oQuelle = Nothing
    
End Sub


Autor: Marc Wershoven (2017)

Anzeige

VBA Programmierer gesucht?
http://www.WershovenOnline.de

Anzeige

Der Quick E-Mail Support von WershovenOnline®

Schnelle Hilfe bei Fragen rund um Microsoft® Office und VBA Makros

Der Quick E-Mail Support von WershovenOnline® Sie haben beispielsweise eine Frage zu einer Ihrer eigenen Makroprogrammierungen in VBA? Oder Sie suchen Unterstützung und Informationen über eine bestimmte Microsoft® Excel® Formel? Bei nahezu allen Fragen und Problemen rund um Microsoft® Office und VBA Makros steht Ihnen unser individueller Quick E-Mail Support zur Verfügung. Einfach, schnell und unkompliziert Ihre Frage in einer E-Mail formulieren, mit oder ohne Screenshots oder einer Beispieldatei absenden und kurze Zeit später haben Sie eine vollständige Lösung inkl. ausführlicher Erklärung vom Profi in Ihrem Postfach! Zusätzlich besteht die Option, dass wir uns mittels Fernwartung (selbstverständlich nach Ihrem Einvertändnis) direkt "live" mit Ihnen zusammen an Ihrem Bildschirm gemeinsam Fragen und Problemstellungen anschauen und lösen können!

Weitere Informationen zu diesem kostenpflichtigen Angebot finden Sie auf der Anbieterseite von WershovenOnline® auf www.wershovenonline.de.

Zum Anbieter des Quick-E-Mail-Support...

Zum Seitenanfang