Aktualisierung über eine andere Datei
05.02.2021 11:34:24
Matthias
ich wollte mich erkundigen, wie ich die Abfrage so aufbauen kann, dass ich die aktuellen Datensätze aus einer Excel-Datei in die nächste übertragen kann.
Ich versuche mein Wunsch mit einem Beispiel zu präzisieren:
Excel-Datei_1:
Hat Daten in der Spalte A bis Q. In der Spalte A ist ein Datum mit einem Zeitstempel (24.12.2020 07:51).
In der zweiten Liste habe ich auch eine Spalte G bis W mit dem oben beschriebenen Zeitstempel.
In beiden Listen ist das aktuellste Datum mit der Uhrzeit absteigend sortiert.
Das Programm soll aus der ersten Liste alle Datensätze mit einem aktuellerem Datum als die aus der Liste 2 übertragen. Hierbei soll die gesamte Zeile übertragen werden.
Ich habe bislang folgende Lösung erarbeitet:
Dim Wq As Worksheet 'Quelle
Dim Wz As Worksheet 'Ziel
Sub Uebertrage()
Dim Z
Set Wq = Workbooks("Liste_2").Worksheets("Tabelle1")
Set Wz = Workbooks("Liste_2").Worksheets("Tabelle2")
Sortieren Wq, "A1:C1000", "C1", xlAscending
Sortieren Wz, "F1:H1000", "H1", xlDescending
For Each Z In Wq.Range(Wq.Range("C1"), Wq.Range("C10000").End(xlUp)).Cells
If Z >= Wz.Range("H1") Then Exit For
Next
If Z Wq.Range(Z.Offset(0, -2), Wq.Range("C10000").End(xlUp)).Copy
Wz.Activate
Wz.Range("F10000").End(xlUp).Offset(1, 0).Select
Wz.Paste
Application.CutCopyMode = False
Sortieren Wz, "F1:H200", "H1", xlDescending
End Sub
Private Sub Sortieren(W As Worksheet, SortBereich As String, SortZelle As String, Richtung As _
XlSortOrder)
With W.Sort
.SortFields.Clear
.SortFields.Add _
Key:=Intersect(W.Range(SortBereich), W.Range(SortZelle).EntireColumn), _
SortOn:=xlSortOnValues, Order:=Richtung, DataOption:=xlSortNormal
.SetRange W.Range(SortBereich)
.Header = xlNo
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
End Sub
Ich selbst hab im Netz einen Code gefunden und angepasst.
Option Explicit
Sub OeffnenDialog_mit_Pfadvorgabe()
'** Anzeige des Öffnen-Dialogfensters mit voreingestelltem Pfad
'** Dimensionierung der Variablen
Dim lshThis As Worksheet, lshOther As Worksheet
Dim wb As Workbook
Dim lngZ As Long
Dim strFileName
Dim strFilter As String
'** Dateifilter definieren
strFilter = "Excel-Dateien(*.xl*), *.xl*"
'** Laufwerk und Pfad definieren, welcher geöffnet werden soll
ChDrive "C"
ChDir "C:\Projekt"
'** Den im Dialogfeld gewählten Namen auslesen
strFileName = Application.GetOpenFilename(strFilter)
'** Prüfen, ob eine gültige Datei ausgewählt wurde
If strFileName = False Then Exit Sub
'** Gewählte Datei öffnen
Set wb = Workbooks.Open(strFileName)
'**Erste Registerkarte wird ausgelesen und in die erste Registerkarte abgelegt
Set lshThis = ThisWorkbook.Sheets(1)
Set lshOther = ActiveWorkbook.Sheets(1)
'**Inhalt der Zellen A1: bis O500 wird kopiert und in F1 eingefügt
lshOther.Range("A1:O500").Copy lshThis.Range("F1")
ActiveWorkbook.Close False
End Sub
Dies macht aber nur einen Abgleich von zwei Tabellen Blätter innerhalb einer Datei. Diese Lösung wurde mir freundlicherweise aus der Community gestellt.
Ich Selbst habe ein Code, der über ein Fenster die Daten OHNE Abgleich überträgt.
Wie kann ich den Abgleich der Daten samt der Spalten einbauen?
Ich bedanke mich.
Matthias