AW: Daten zusammen führen
30.10.2007 02:23:31
fcs
Hallo Nagl,
damit das Makro in deiner Originaldatei funktioniert machst du folgendes:
1. Du kopierts den Code unter Tabelle1 aus K.Rola's Datei und fügst ihn in deiner Original-Datei unter Tabelle1 ein. Alternativ kannst du ihn auch in einem allgemeinen Modul einfügen.
Wegen leichterem Verständnis empfehle ich meine nachfolgende Code-Variante zu verwenden, in der die beiden Tabellenblätter entsprechenden Objektvariablen zugewiesen werden.
2. Zwecks Bedienungskomfort legst du aus der Symbolleiste "Formular" im Blatt "Anpassung MA" einen Befehlsbutton an. Diesem weist du dann das Makro "limation" zu.
Damit ist das Makro funktionsfähig.
Das Makro führt folgende Funktionen aus:
1. Das Makro ermittelt in der Tabelle "Informationen aus..." die Anzahl Spalten und Zeilen
2. Die Spaltentitel der beiden Tabellen werden verglichen
(Diese ist eine kleine Sicherheitsmaßnahme gegen versehentlich falsches Einfügen von Daten)
3. Zeilenweise werden die Personalnummern im Blatt "Informationen..." im Blatt "Anpassung MA" gesucht.
Wird die Personalnummer gefunden, dann wird in der entsprechenden Zeile die Abladestelle per Kopieren der Zelle eingetragen. Falls nicht, dann wird die Personalnummer in einer Meldung angezeigt.
Um die Daten im Blatt "Anpasung MA" zu aktualiseren löscht du zunächst die Daten im Blatt "Informationen..". Dann kopierst du die Daten aus der Informations-Datei die du bekommst in das Blatt. Anschließend startest du das Makro "limation" per Buttonklick oder via Menü "Extras--Makro .."
Gruß
Franz
Sub limation()
Dim z As Long, lz As Long, rc As Long, cRow As Long
Dim s As Integer, ls As Integer, cc As Integer
Dim c As Range
Dim SB As Variant
Dim bolOK As Boolean
Dim wksAnpassung As Worksheet, wksInfo As Worksheet
Set wksAnpassung = Worksheets("Anpassung MA")
Set wksInfo = Worksheets("INFORMATIONEN aus anderen Exel")
rc = wksInfo.Rows.Count
lz = IIf(wksInfo.Cells(rc, 1) "", rc, wksInfo.Cells(rc, 1).End(-4162).Row)
cc = wksInfo.Columns.Count
ls = IIf(wksInfo.Cells(1, cc) "", cc, wksInfo.Cells(1, cc).End(-4159).Column)
''Testen, ob Spaltenüberschriften überein stimmen.
bolOK = -1
For s = 1 To ls
If wksAnpassung.Cells(1, s) wksInfo.Cells(1, s) Then
bolOK = 0
Exit For
End If
Next
If bolOK Then
''Wenn Spalten ok dann....
For z = 2 To lz
SB = wksInfo.Cells(z, 1)
Set c = wksAnpassung.Columns(1).Find(what:=SB, lookat:=1)
If Not c Is Nothing Then
cRow = c.Row
wksInfo.Cells(z, 7).Copy wksAnpassung.Cells(cRow, 7)
Else
MsgBox SB & " Nicht gefunden! ", 64, "Weise hin..."
End If
Next
Set c = Nothing
Else
''sonst
MsgBox "Spaltenüberschriften stimmen nicht überein! ", 64, "Weise hin..."
End If
End Sub