Office Forum
www.Office-Loesung.de
Access :: Excel :: Outlook :: PowerPoint :: Word :: Office :: Wieder Online ---> provisorisches Office Forum <-
Neue Nummern in bestehnde Tabelle vergleichen/einfügen
zurück: Import über einen Button weiter: Tabellen abgleichen und aktualsieren Unbeantwortete Beiträge anzeigen
Neues Thema eröffnen   Neue Antwort erstellen     Status: Offen Facebook-Likes Diese Seite Freunden empfehlen
Zu Browser-Favoriten hinzufügen
Autor Nachricht
Reile
Im Profil kannst Du frei den Rang ändern


Verfasst am:
29. Apr 2014, 16:27
Rufname:

Neue Nummern in bestehnde Tabelle vergleichen/einfügen - Neue Nummern in bestehnde Tabelle vergleichen/einfügen

Nach oben
       Version: Office 2010

Hallo,

ich habe eine Überprüfung mit Ergänzung wo ich Hilfe bräuchte:

In Tabelle1 (Tabelle1) habe ich laufende Nummern.

1
2
3
...
99
100

In einer zweiten Tabelle (Tabelle2) habe ich eine aktuellere Liste.

1
2
3
...
100
101
102
103

Jetzt soll das Macro die letze Zahl in Tabelle1 ermitteln (100) und mit Tabelle2 vergleichen. Gibt es Zahlen die Höher sind als 100, dann soll er diese in Tabelle1 nach 100 reinkopieren. (Die Zahlen sind immer aufsteigend sortiert)

Die Zahlen sind jeweils in der Spalte A.

Danke
Little Hobbit
Office-VBA-Programmierer


Verfasst am:
29. Apr 2014, 17:18
Rufname:

AW: Neue Nummern in bestehnde Tabelle vergleichen/einfügen - AW: Neue Nummern in bestehnde Tabelle vergleichen/einfügen

Nach oben
       Version: Office 2010

Razz

Hallo,

hier ein Lösungsvorschlag:

Code:

Option Explicit


Sub UpdateTabelle()
    'ohne Fehlerbehandlung
    'Tabelle 1 Spalte A wird upgedatet mit Daten von Tabelle 2 Spalte A
    'Daten stehen in beiden Tabellen jeweils ab Zeile 1 und sind aufsteigend sortiert

    Dim objWbk          As Workbook
    Dim objSheet1       As Worksheet
    Dim objSheet2       As Worksheet
    Dim lgZeile1        As Long
    Dim lgZeile2        As Long
    Dim intDiff         As Integer
   
    Set objWbk = ThisWorkbook
    Set objSheet1 = objWbk.Worksheets("Tabelle1")
    Set objSheet2 = objWbk.Worksheets("Tabelle2")
   
    lgZeile1 = LetzteZeile(objSheet1)
    lgZeile2 = LetzteZeile(objSheet2)
   
    'Differnez zwischen den Tabellen ermitten
    intDiff = objSheet2.Cells(lgZeile2, 1).Value - objSheet1.Cells(lgZeile1, 1).Value
   
    'Prüfen, ob Differenz vorhanden ist
    If intDiff > 0 Then
        With objSheet2
            'fehlende Daten kopieren
            objSheet1.Range(objSheet1.Cells(lgZeile1 + 1, 1), objSheet1.Cells(lgZeile1 + intDiff + 1, 1)).Value = .Range(.Cells(lgZeile2 - intDiff, 1), .Cells(lgZeile2, 1)).Value
        End With
    Else
        'Tabellen sind gleich
    End If
   
   
    Set objSheet1 = Nothing
    Set objSheet2 = Nothing
    Set objWbk = Nothing
End Sub

Private Function LetzteZeile(ByVal WKS As Worksheet, Optional Spalte As Long) As Long
    If Spalte = 0 Then Spalte = 1
    LetzteZeile = WKS.Cells(Rows.Count, Spalte).End(xlUp).Row
End Function


Gruß
Little Hobbit

_________________
(Frage + Antwort) x Rückmeldung = aktives Forum
Reile
Im Profil kannst Du frei den Rang ändern


Verfasst am:
30. Apr 2014, 11:17
Rufname:

AW: Neue Nummern in bestehnde Tabelle vergleichen/einfügen - AW: Neue Nummern in bestehnde Tabelle vergleichen/einfügen

Nach oben
       Version: Office 2010

Hallo,

danke funktioniert schon sehr gut! Ich habe es getestet und mir sind zwei Sachen aufgefallen:

1. Daten aktualisieren:
Ich habe zwei Tabellen: In Tabelle1 ab A3 habe ich die Zahlen 1,2,3,5
In Tabelle2 ab A2 habe ich die Zahlen 1,2,3,5,7,8,10

Wenn ich das Makro laufen lasse, dann kopiert es mir in der Tabelle1 die fehlenden Zahlen aber nicht ab der letzten Zahl in Tabelle2. Das Ergebnis sieht wie folgt aus: 1.2.3.5.2.3.5.7.8.10

Leider kenn ich mich zu wenig aus um hier selber Hand anzulegen. Zumindest nehme ich an, dass es in Tabelle1 nicht die letzte Zahl sich merkt (5), in Tabelle2 die Zahl 5 sucht und wenn es eine Zahl höher als 5 gibt dann diese und die folgenden Zahlen kopieren und in Tabelle1 nach Zahl 5 einfügt.

Grüße
Gast



Verfasst am:
30. Apr 2014, 15:31
Rufname:

AW: Neue Nummern in bestehnde Tabelle vergleichen/einfügen - AW: Neue Nummern in bestehnde Tabelle vergleichen/einfügen

Nach oben
       Version: Office 2010

Razz
Hallo,

bei meinem Test habe ich den Fehler nicht nachvollziehen können. Dabei ist mir jedoch noch ein Fehler aufgefallen, den ich in der neuen Version korrigiert habe.
Wichtig für den Ablauf des Programms ist, daß in beiden Tabellen die Werte in Spalte A ab Zeile 1 stehen. Das Programm prüft nicht den Inhalt der einzelnen Zellen sondern kopiert nur die zusätzlichen Zeilen in Tabelle 2 hinter die Daten in Tabelle 1.

Code:


Option Explicit
Sub UpdateTabelle()
    'ohne Fehlerbehandlung
    'Daten stehen in beiden Tabellen in Spalte A ab Zeile 1
    'Daten sind in beiden Tabellen aufsteigend sortiert und identisch bis auf zusätzliche neue Zeilen am Ende von Tabelle 2
    'Progamm kopiert die Daten aus Tabelle 2 Spalte A in Tabelle 2 Spalte A,
    'die hinter der letzten gemeinsamen Zeile beider Tabellen in Tabelle 2 stehen in Tabelle 1
    'hinter die letzte gefüllte Zeile.
   
    Dim objWbk          As Workbook
    Dim objSheet1       As Worksheet
    Dim objSheet2       As Worksheet
    Dim lgZeile1        As Long
    Dim lgZeile2        As Long
    Dim intDiff         As Integer
   
    Set objWbk = ThisWorkbook
    Set objSheet1 = objWbk.Worksheets("Tabelle1")
    Set objSheet2 = objWbk.Worksheets("Tabelle2")
   
    lgZeile1 = LetzteZeile(objSheet1, 1)
    lgZeile2 = LetzteZeile(objSheet2, 1)
   
    'Differnez zwischen den Tabellen mitten
    intDiff = objSheet2.Cells(lgZeile2, 1).Value - objSheet1.Cells(lgZeile1, 1).Value
   
    'Prüfen, ob Differenz vorhanden ist
    If intDiff > 0 Then
        With objSheet2
            'fehlende Daten kopieren
            objSheet1.Range(objSheet1.Cells(lgZeile1 + 1, 1), objSheet1.Cells(lgZeile1 + intDiff, 1)).Value = _
                .Range(.Cells(lgZeile2 - intDiff + 1, 1), .Cells(lgZeile2, 1)).Value

        End With
    Else
        'Tabellen sind gleich
    End If
   
    Set objSheet1 = Nothing
    Set objSheet2 = Nothing
    Set objWbk = Nothing
End Sub

Private Function LetzteZeile(ByVal WKS As Worksheet, Optional Spalte As Long) As Long
    If Spalte = 0 Then Spalte = 1
    LetzteZeile = WKS.Cells(Rows.Count, Spalte).End(xlUp).Row
End Function



Viel Erfolg
Little Hobbit
Reile
Im Profil kannst Du frei den Rang ändern


Verfasst am:
30. Apr 2014, 17:19
Rufname:

AW: Neue Nummern in bestehnde Tabelle vergleichen/einfügen - AW: Neue Nummern in bestehnde Tabelle vergleichen/einfügen

Nach oben
       Version: Office 2010

Hallo,

danke für die Hilfe. Ich habe die Daten in beiden Tabellen ab A1 eingefügt.

Tabelle1: 1,2,3
Tabelle2: 1,2,3,4,5,6,7,8

Ergebnis nach Macro:
Tabelle1: 1,2,3,4,5,6,7,8

Das von mir beschriebene Vorgang entsteht nur wenn die Zahlen nicht durchgehend sind:

Tabelle1: 1,2,3
Tabelle2: 1,2,3,4,5,7,8

Ergebnis nach Macro:
Tabelle1: 1,2,3,3,4,5,7,8

Grüße
Neues Thema eröffnen   Neue Antwort erstellen Alle Zeiten sind
GMT + 1 Stunde

Diese Seite Freunden empfehlen

Seite 1 von 1
Gehe zu:  
Du kannst Beiträge in dieses Forum schreiben.
Du kannst auf Beiträge in diesem Forum antworten.
Du kannst deine Beiträge in diesem Forum nicht bearbeiten.
Du kannst deine Beiträge in diesem Forum nicht löschen.
Du kannst an Umfragen in diesem Forum nicht mitmachen.
Du kannst Dateien in diesem Forum nicht posten
Du kannst Dateien in diesem Forum herunterladen

Verwandte Themen
Forum / Themen   Antworten   Autor   Aufrufe   Letzter Beitrag 
Keine neuen Beiträge Excel Formeln: Dateinamen für zu öffnende Tabelle in Zelle vorgeben, wie? 4 excessor 1698 24. Jan 2005, 22:52
A.Knecht Dateinamen für zu öffnende Tabelle in Zelle vorgeben, wie?
Keine neuen Beiträge Excel Formeln: Verknüpfung Access Tabelle 1 DB_User 1788 17. Jan 2005, 11:54
ZeroCool Verknüpfung Access Tabelle
Keine neuen Beiträge Excel Formeln: Eine Zeile am Ende mit einem CommandButton einfügen 0 chico24 884 11. Jan 2005, 10:29
chico24 Eine Zeile am Ende mit einem CommandButton einfügen
Keine neuen Beiträge Excel Formeln: Text in andere Tabelle übertragen 2 freddy-krueger 3737 02. Dez 2004, 11:16
freddy-krueger Text in andere Tabelle übertragen
Keine neuen Beiträge Excel Formeln: Tabelle 'automatisch' bereinigen 4 ExcelFan 2188 16. Nov 2004, 11:11
fridgenep Tabelle 'automatisch' bereinigen
Keine neuen Beiträge Excel Formeln: Zellen vergleichen / Zeilen löschen 3 Satanico 2994 28. Okt 2004, 15:37
icke Zellen vergleichen / Zeilen löschen
Keine neuen Beiträge Excel Formeln: Text vergleichen 1 miss_jacy 1490 23. Okt 2004, 19:14
Reinhard Text vergleichen
Keine neuen Beiträge Excel Formeln: Wochentag einfügen / Daten übernehmen nach Datum 4 muttalip 3003 22. Sep 2004, 18:20
muttalip Wochentag einfügen / Daten übernehmen nach Datum
Keine neuen Beiträge Excel Formeln: Tabellendaten mit SVERWEIS vergleichen 7 Gast 6039 19. Sep 2004, 00:45
fl618 Tabellendaten mit SVERWEIS vergleichen
Keine neuen Beiträge Excel Formeln: Gleiche Einträge in Tabelle nummerich aufzählen 1 sauer 483 02. Sep 2004, 09:11
ae Gleiche Einträge in Tabelle nummerich aufzählen
Keine neuen Beiträge Excel Formeln: aus Tabelle auslesen und vergleichen 1 wiedenmann 2805 12. Aug 2004, 13:42
Arnim aus Tabelle auslesen und vergleichen
Keine neuen Beiträge Excel Formeln: Datenübernahme aus Tabelle 7 lut155 21997 05. Aug 2004, 15:12
Gast Datenübernahme aus Tabelle
 

----> Diese Seite Freunden empfehlen <------ Impressum - Besuchen Sie auch: Macromedia Dreamweaver