AW: Daten aus einer anderen Mappe synchronisieren
28.08.2014 11:01:01
fcs
Hallo Jafa,
hier ein Makro, dass die Daten in der Überwachungsdatei mit den Daten in der Eingabedatei abgleicht.
Als Schaltfläche fügst du im Tabellenblatt eine Schaltfläche aus den Formular-Steuerelementen ein und weist der Schaltfläche das Makro zu.
Gruß
Franz
'Makro in einem allgemeinen Modul der Überwachungsarbeitsmappe
Sub DatenHolenAusEingabeMappe()
Dim Zeile_Q As Long, Spalte_Q As Long
Dim ZeileMax As Long
Dim Zeile_Z As Long
Dim rngTreffer As Range, rngSuche As Range, strAdr1 As String, bolNeu As Boolean
Dim varPos, varPosNr
Dim wkbQuelle As Workbook, wksQuelle As Worksheet, strQuelle As String, _
strVerzQuelle As String
Dim wkbZiel As Workbook, wksZiel As Worksheet
strQuelle = "Eingabe.xlsm" 'Name der Eingabe-Datei - ggf. anpassen
strVerzQuelle = ThisWorkbook.Path 'Verzeichnis Eingabe-Datei - ggf.anpassen
'prüfen, ob Eingabedatei geöffnet ist
For Each wkbQuelle In Application.Workbooks
If LCase(wkbQuelle.Name) = LCase(strQuelle) Then
MsgBox "Die Eingabe-Datei ist noch geöffnet, bitte Datei erst speichern und schließen"
wkbQuelle.Activate
GoTo Beenden
End If
Next
Set wkbZiel = ThisWorkbook
Set wksZiel = wkbZiel.Worksheets(1)
'Quelle schreibgeschützt öffnen
Set wkbQuelle = Workbooks.Open(strVerzQuelle & "\" & strQuelle)
Set wksQuelle = wkbQuelle.Worksheets(1)
With Application
.EnableEvents = False
.ScreenUpdating = False
End With
With wksQuelle
ZeileMax = .Cells(.Rows.Count, 2).End(xlUp).Row
'Zeilen in Quelle (Eingabeblatt) abarbeiten
For Zeile_Q = 6 To ZeileMax
varPos = .Cells(Zeile_Q, 2).Text
varPosNr = .Cells(Zeile_Q, 3).Value
bolNeu = True
With wksZiel
Zeile_Z = .Cells(.Rows.Count, 2).End(xlUp).Row
If Zeile_Z > 5 Then
Set rngSuche = .Range(.Cells(6, 2), .Cells(Zeile_Z, 2))
'Position in Zieltabelle suchen
Set rngTreffer = rngSuche.Find(what:=varPos, LookIn:=xlValues, _
lookAT:=xlWhole)
If rngTreffer Is Nothing Then
'Position ist noch nicht vorhanden
Zeile_Z = Zeile_Z + 1
Else
strAdr1 = rngTreffer.Address '1. Fundstelle merken
Do
If rngTreffer.Offset(0, 1) = varPosNr Then
'Position und Positions-Nr. ist vorhanden
Zeile_Z = rngTreffer.Row
bolNeu = False
Exit Do
End If
'Suche nach Position wiederholen
Set rngTreffer = rngSuche.FindNext(After:=rngTreffer)
If rngTreffer.Address = strAdr1 Then
'Position und Positions-Nr. ist nicht vorhanden
Zeile_Z = Zeile_Z + 1
Exit Do
End If
Loop
End If
Else
'1. Eintrag in Überwachungsblatt
Zeile_Z = 6
End If
End With
'Werte Spalte_Q A bis K ( 1 bis 11) nach Ziel übertragen
For Spalte_Q = 1 To 11
Select Case Spalte_Q
Case 2, 3
If bolNeu = True Then
wksZiel.Cells(Zeile_Z, Spalte_Q).Value = .Cells(Zeile_Q, Spalte_Q).Value
End If
Case Else
wksZiel.Cells(Zeile_Z, Spalte_Q).Value = .Cells(Zeile_Q, Spalte_Q).Value
End Select
Next Spalte_Q
Next Zeile_Q
End With
wkbQuelle.Close savechanges:=False
'Daten in Zieltabelle sortieren _
aufsteigend nach Eingabedatum, aufsteigend nach Auftrags-/Positionsnummer
With wksZiel
ZeileMax = .Cells(.Rows.Count, 2).End(xlUp).Row
If ZeileMax > 6 Then
With .Range(.Cells(5, 1), .Cells(ZeileMax, 11))
.Sort Key1:=.Range("A1"), Order1:=xlAscending, _
Key2:=.Range("B1"), Order2:=xlAscending, _
Key3:=.Range("C1"), Order3:=xlAscending, Header:=xlYes
End With
End If
End With
Beenden:
With Application
.EnableEvents = True
.ScreenUpdating = True
End With
Set wkbZiel = Nothing: Set wksZiel = Nothing: Set wkbQuelle = Nothing: Set wksQuelle = _
Nothing
Set rngSuche = Nothing: Set rngTreffer = Nothing
End Sub