Feldinhalte zwischen Tabellen per Makro übertragen

~ 0 min
30.11.2016 08:52

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:

Durchschnittliche Bewertung 0 (0 Abstimmungen)

Kommentieren nicht möglich