Feldinhalte zwischen Tabellen per Makro übertragen
Problem:
Oftmals ist es notwendig, Daten zwischen Adresstabellen bzw. von einer Adresstabelle in eine Zusatztabelle zu übertragen.
Lösung:
Hierzu gibt es zu drei unterschiedlichen Anwendungsfällen nachfolgend jeweils ein Makro-Beispiel, welche als MacroIncludes bereitstehen. Diese MacroIncludes können sich sich herunterladen, entpacken und importieren. Anschließend muss der Makrocode an die jeweilige Datenstruktur angepasst werden.
1. Fall: Sie möchten Daten von der aktuell geöffneten Adresstabelle in eine andere Adresstabelle übertragen
Werte übertragen von Adresstabelle in fremde Adresstabelle.zip
'Werte übertragen von Adresstabelle in fremde Adresstabelle
'Version 1.00.001 LH 2016-11-28
Dim MeineTabelle, oRecord
'Zugreifen auf eine Adresstabelle und speichern in der Variable MeineTabelle
Set MeineTabelle = Application.AddressSets("Kunden")
'Suchen nach der Adresse mit einer bestimmten Kundennummer in der Adresstabelle „MeineTabelle“ und speichern in der Variable oRecords
Set oRecords = MeineTabelle.Query("Number='12345'")
'Prüfen, ob es mehr als einen Datensatz mit dieser Kundennummer gibt
If oRecords.Count = 1 Then
'Aufzählungsobjekt durchiterieren
For Each oRecord in oRecords
'Nun wird der Wert des Feldes Name1 vom geöffneten Datensatz in den der anderen Adresstabelle geschrieben
If oRecord.Lock Then
oRecord.Fields("Name1").Value = ActiveRecord.Fields("Name1").Value
Else
MsgBox "Der Datensatz konnte nicht gesperrt werden."
End If
Next
Else
If oRecords.Count = 0 Then
MsgBox "Keinen Datensatz gefunden."
Else
MsgBox "Es gibt mehrere Datensätze mit der gleichen Kundennummer."
End If
End If
2. Fall: Sie möchten Daten von einer anderen Adresstabelle in die aktuell geöffnete Adresstabelle übertragen
Werte übertragen von fremder Adresstabelle in Adresstabelle.zip
'Werte übertragen von fremder Adresstabelle in Adresstabelle
'Version 1.00.001 LH 2016-11-28
Dim MeineTabelle, oRecord, oRecords
'Zugreifen auf eine Adresstabelle und speichern in der Variable MeineTabelle
Set MeineTabelle = Application.AddressSets("Kunden")
'Suchen nach der Adresse mit einer bestimmten Kundennummer in der Adresstabelle „MeineTabelle“ und speichern in der Variable oRecords
Set oRecords = MeineTabelle.Query("Number='12345'")
'Prüfen, ob es mehr als einen Datensatz mit dieser Kundennummer gibt
If oRecords.Count = 1 Then
'Aufzählungsobjekt durchiterieren
For Each oRecord in oRecords
'Nun wird der Wert des Feldes Name1 vom Datensatz der Adresstabelle „Kunden“ in den Datensatz der aktuell geöffneten Adresstabelle geschrieben
ActiveRecord.Fields("Name1").Value = oRecord.Fields("Name1").Value
Next
Else
If oRecords.Count = 0 Then
MsgBox "Keinen Datensatz gefunden."
Else
MsgBox "Es gibt mehrere Datensätze mit der gleichen Kundennummer."
End If
End If
3. Fall: Sie möchten Daten von einer anderen Adresstabelle in die Zusatztabelle einer aktuell geöffneten Adresstabelle übertragen
Werte übertragen von fremder Adresstabelle in Zusatztabelle.zip
'Werte übertragen von fremder Adresstabelle in Zusatztabelle
'Version 1.00.001 LH 2016-11-28
Dim MeineTabelle, oRecord, oRelation, oEntry, oRecords
'Zugreifen auf eine Adresstabelle und speichern in der Variable MeineTabelle
Set MeineTabelle = Application.AddressSets("Kunden")
'Suchen nach der Adresse mit einer bestimmten Kundennummer in der Adresstabelle „MeineTabelle“ und speichern in der Variable oRecords
Set oRecords = MeineTabelle.Query("Number='12345'")
'Prüfen, ob es mehr als einen Datensatz mit dieser Kundennummer gibt
If oRecords.Count = 1 Then
'Aufzählungsobjekt durchiterieren
For Each oRecord in oRecords
'Zusatztabelle "Produkte" des Datensatzes bearbeiten
Set oRelation = ActiveRecord.Relations("Produkte")
'Hinzufügen einer neuen Zeile und setzen von Werten
Set oEntry = ORelation.Add
oEntry.Fields("Artikel") = oRecord.Fields("K_Artikel").Value
oEntry.Fields("Anzahl") = oRecord.Fields("K_Anzahl").Value
Next
Else
If oRecords.Count = 0 Then
MsgBox "Keinen Datensatz gefunden."
Else
MsgBox "Es gibt mehrere Datensätze mit der gleichen Kundennummer."
End If
End If
Angehängte Dateien: