ich habe eine Tabelle1 und eine Tabelle2 (verschiedene Dateien) mit gleichen Tabellenkopf. Die Daten aus Tabelle2 sollen in Tabelle1 übernommen werden. Das habe ich soweit geschafft (VBA: Abfrage der zu öffnenden Datei für Tabelle2, alle Daten unten angefügt). Ziel ist aber, dass ein Spaltenwert (Spalte6) nur einmal vorkommen soll, so dass bei gleichen Werten in Spalte6 die komplette Zeile aus Tabelle2 in die entsprechend vorhanden Zeile in Tabelle1 kopiert (überschrieben) werden soll. Das bekomme ich leider nicht hin, je länger ich darüber grübele, um so verwirrender wird es . Kann jemand helfen? Danke. (benutze Excel2003)
ich weiß nicht, ob ich das Problem richtig verstehe, aber im Prinzip sollte es eine Abfrage über die Spalte A der Tabelle 1 sein, ob es diesen Wert bereits gibt.
Die könnte durch eine for .. do .. loop (s. VBA Hilfe) in Kombination mit einer if .. then Bedingung ausgeführt werden.
So nach dem Motto:
For i= 0…letzter Wert Spalte A do
if Wert gleich Wert i then
next i
else in neue zeile einfügen
Bitte die VBA Hilfe durchsuchen, da gibt es Beispiele.
Stichworte do loop, if then next usw.
Hallo
Ja, im Grunde genommen musst du mit einer For-Schleife im VBA immer überprüfen ob der aktuelle Wert schon in der Spalte6 der Tabelle 1 schon existiert. Hierfür brauchst Du sicherlich mal 2 For schleifen. Eine Für das Aussuchen der Spalte 6, sowie eine für die tabelle 2. Weiter benötigst Du für das unten Anfügen in der tabelle1 eine fortlaufende Nummer.
Beginnen wir mal.
Ausgangslage: Tabelle1 ist leer, Tabelle 2 enthält die gesuchten daten und hat in Spalte 6 mehrmals den gleichen String. Tabelle 2 hat 100 Datensätze
Dim i as long, l as long, r as long
i=1
l=1
r=1
For i=1 to 100
'Ablaufen der tabelle2
For l=1 to r
'Ablaufen der Spalte6 in tabelle1
if tabelle2.cells(i,6)=tabelle1.cells(l,6) then
'Ein gleicher Datensatz wurde gefunden.
exit for
end if
next l
If l=r then
'kein Datensatz wurde gefunden, tabelle erweitern
r=r+1
tabelle1.cells(r,6)=tabelle2.cells(i,6)
else
'Doppelter Datensatz
tabelle1.cells(l,6)=tabelle2.cells(i,6)
end if
Ich bin mit jetzt nicht sicher was das Ziel sein soll.
Wenn a mit b verglichen wird, dann kennt man die Position des Vergleichs und kann so auf bestimmte Ergebnisse reagieren.
Wenn aber alle Daten von a einfach an b angehängt werden, so gäbe es eventuell fertige Funktionen um Dubletten zu finden und zu löschen. Ansonsten müsste man die neue Tabelle mit einer Schleife durchlaufen lassen und prüfen ob es einem doppelten Wert gibt
hier ein praxiserprobtes Makro zur Aktualisierung von Daten in einem Tabellenblatt mit einer Spalte die einen eindeutigen Schlüsswert (Key, ID, Kennung) enthält.
Gruß
Franz
Sub Hole\_Daten\_aus\_Datei()
Dim wkbQuelle As Workbook, wksQuelle As Worksheet
Dim wkbZiel As Workbook, wksZiel As Worksheet
Dim varAuswahl As Variant
Dim rngZiel As Range, lngZeile\_Q As Long, lngZeile\_Z As Long
Dim SpalteKey As Long
Dim StatusCalc As Long
On Error GoTo Fehler
Set wkbZiel = ActiveWorkbook
Set wksZiel = wkbZiel.Worksheets(1) '1 ggf. durch andere Ziffer/Namen in \_
Anführungszeichen ersetzen
varAuswahl = Application.GetOpenFilename(Filefilter:= \_
"Exceldateien(\*.xls;\*.xlsx;\*.xlsm;\*.xlsb), \*.xls;\*.xlsx;\*.xlsm;\*.xlsb", \_
Title:="Bitte Datei mit den einzufügenden Daten auswählen")
If varAuswahl = False Then GoTo Beenden
'ausgewählte Datei schreibgeschützt öffnen
Set wkbQuelle = Application.Workbooks.Open(Filename:=varAuswahl, ReadOnly:=True)
Set wksQuelle = wkbQuelle.Worksheets(1) '1 ggf. durch andere Ziffer/Namen in \_
Anführungszeichen ersetzen
SpalteKey = 6 'Spalte mit den eindeutigen Schlüsseldaten, ID, Kennung
'Makrobremsen lösen
With Application
.EnableEvents = False
StatusCalc = .Application.Calculation
.Calculation = xlCalculationManual
.ScreenUpdating = False
End With
With wksQuelle
'Zeilen in Quelldatei abarbeiten - Startzeile ggf. anpassen
For lngZeile\_Q = 2 To .Cells(.Rows.Count, SpalteKey).End(xlUp).Row
varAuswahl = .Cells(lngZeile\_Q, SpalteKey).Value
If varAuswahl "" Then
With wksZiel
'Wert aus SpalteKey der Quelle in der Zieltabelle suchen
Set rngZiel = .Columns(SpalteKey).Find(what:=varAuswahl, LookIn:=xlValues, \_
lookat:=xlWhole)
If rngZiel Is Nothing Then
lngZeile\_Z = .Cells(.Rows.Count, SpalteKey).End(xlUp).Row + 1
Else
lngZeile\_Z = rngZiel.Row
End If
End With
'Quellzeile in Zieltabelle kopieren
.Rows(lngZeile\_Q).Copy Destination:=wksZiel.Rows(lngZeile\_Z)
End If
Next lngZeile\_Q
End With
'Quelldatei ohne Speichern wieder schliessen
wkbQuelle.Close savechanges:=False
'Fehlerbehandlung
Err.Clear
Fehler:
With Err
Select Case .Number
Case 0 'kein Fehler
Case Else
MsgBox "Fehler-Nr.: " & .Number & vbLf & .Description
End Select
End With
'Makrobremsen zurücksetzen
With Application
.EnableEvents = True
.Calculation = StatusCalc
.ScreenUpdating = True
End With
Beenden:
Set rngZiel = Nothing: Set wkbQuelle = Nothing: Set wksQuelle = Nothing
Set wkbZiel = Nothing: Set wksZiel = Nothing
End Sub
Hallo di_ma,
Programmiererfahrung hast Du wohl. Also konzentriere ich mich auf das Konzept:
Alles aus Tabelle2 (andere Datei als Tabelle1) soll in Tabelle1? Abhängig vom Wert in Spalte 6 soll der Datensatz entweder in Tabelle1 unten angehängt werden, oder die komplette Zeile in Tabelle1 ersetzen?
Ich würde also in Tabelle2 einen Zähler führen, von Zeile 2 (in 1 steht die Überschrift), bis zur letzten Zeile den .Value der Zeile n und Spalte 6 in eine Variable schreiben, und die komplette Zeile kopieren.
Dann in Tabelle1 alle Zeilen von 1 bis zur ersten freien Zeile durchlaufen und den Wert der Spalte 6 abfragen. Wenn der Wert der Variablen entspricht, wird die Zeile überschrieben, wenn der Wert „“ ist, ist die Zeile leer und wird überschreiben.
Dann zurück in Tabelle2, Zähler um 1 erhöhen und so bis zur letzten Zeile.
. Kann jemand helfen? Danke. (benutze Excel2003)