AW: Dateien verbinden
07.07.2006 15:37:48
fcs
Hallo Daniel,
damit eine Verbindung zwischen den beiden Dateien hergestellt werden kann, müssen die Informationen in den beiden Dateien eindeutig verknüpft sein.
In der 1. Datei ist dies der Name des Tabellenblattes(Fertigungsauftragsnummer) plus die Einträge in den Zellen Q2 bis AA2
In der 2. Datei sind jedoch "nur" der Tabellenblattname(Monatsname) und die Einträge aus den Zellen Q2 bis AA2 für verschiedene Fertigungsauftragsnummern vorhanden.
Damit man per VBA die Inhalte zwischen beiden Dateien abgleichen kann, müssen die Inhalte von einer oder mehreren Zellen jeden Datensatz eindeutig identifizieren. Am "einfachsten" ginge es, wenn in der 2. Datei in jeder Zeile auch die eindeutige Fertigungsauftragsnummer eingetragen wäre. Oder kann die in mehreren Monatsblättern/Zeilen vorkommen? Danach kann man dann 2 Prozeduren schreiben die
1. bei Änderungen in Datei 1 die Monatsblätter der 2. Datei nach dem zutreffenden Eintrag durchsucht und die Daten abgleicht.
2. bei Änderungen in Datei 2 die Fertigungsauftragsblätter der 2. Datei nach dem zutreffenden Eintrag durchsucht und die Daten abgleicht.
Ich hab mir mal deinen bisherigen Code angesehen. Er läßt sich noch stark vereinfachen, indem auf die vielen Select/Activate-Anweisungen verzichtet wird. Ohne Garantie, dass er sauber durchläuft (kann ja nicht testen) kann es so aussehen
mfg
Franz
Sub neueKarte_Click()
' neueKarte Makro
Sheets("Beanstandungskarte").Copy After:=Sheets("Beanstandungskarte")
' Range("P2").Select
' Selection.Copy
' Range("J9").Select
' Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
' :=False, Transpose:=False
'Range( _ "F2:K2,F3:K3,F4:K4,F5:K5,A2:B3,E8:F8,F16:K16,F17:K17,F18:K18,H24" _ ).Select
Application.CutCopyMode = False
' Selection.ClearContents
Range("F2:K2").Select
End Sub
Sub blattname_click()
' Tabellenblattname aus E8 entnehmen
If IsEmpty(Range("E8")) Then
Range("E8").Value = "Fertigungsauftrag fehlt"
End If
ActiveSheet.Name = Range("E8").Value 'bei aktiven Tabellenblatt
End Sub
Sub speichern_click()
ActiveWorkbook.Save
Application.Quit
End Sub
Sub Eintragen_Click()
' Eintragen Makro
Dim wbQuelle As Workbook, wbZiel As Workbook
Dim wksQuelle As Worksheet, wksZiel As Worksheet
Set wbQuelle = ActiveWorkbook
Set wksQuelle = ActiveSheet
wbQuelle.Save
'ChDir "O:\Ab-GM\Produktion\M P A\Beanstandungskarten" 'speichern
Set wbZiel = Workbooks.Open(Filename:= _
"O:\Ab-GM\Produktion\M P C\Beanstandungskarten\Beanstandungskartenliste_MPC.xls")
Windows.Arrange ArrangeStyle:=xlHorizontal 'Fenster horizontal anzeigen
Set wksZiel = wbZiel.Sheets(Format(wbZiel.Worksheets("Datum").Range("A1").Value, "MMMM"))
wksZiel.Rows("3:3").Insert Shift:=xlDown
wksQuelle.Range("Q2:AA2").Copy
wksZiel.Range("A3").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
wbZiel.Save
wksQuelle.Range("E8:F8").Select
wbQuelle.Save
End Sub