Makro funktioniert nicht richtig, Werte auslesen
07.11.2008 08:22:00
Uwe
Hallo Uwe,
unregelmäßig aufgebaute Tabellen per Makro abzuarbeiten ist immer ziemlich aufwendig zu programmieren.
Die manuelle Lösung heißt dann die Zeilennummern fest in den Code eintragen, was dann bei ändeungen oder Ergänzungen an den Tabellen immer auch Code-Änderungen erfordert.
Alternativ könnte man die Informationen zu den Zeilen/Zellen im Blatt "Dienstplan" im Blatt "Kopf" für jeden Mitarbeiter hinterlegen und vom Makro auslesen lassen.
Nachfolgend ein angepasster Code, bei dem die Zeileninformation je Mitarbeiter im Code hinterlegt ist (die schlechteste Lösung von allen).
gruß
Franz
Sub DatenVormonatHolen()
Dim wksDienst As Worksheet, wksKopf As Worksheet, wbMonat
Dim wbVormonat As Workbook, wksDienstVor As Worksheet, wksKopfVor As Worksheet
Dim varAuswahl, bolPruefung As Boolean, strMsg As String
Dim intMit As Integer
'Zeilenwerte für Mitarbeiter im Dienstplan, Werte ggf. anpassen
Const intMitarbeiter As Integer = 24 'Anzahl Mitarbeiter
On Error GoTo Fehler
Set wksDienst = ActiveWorkbook.Worksheets("Dienstplan")
Set wksKopf = ActiveWorkbook.Worksheets("Kopf")
varAuswahl = Application.GetOpenFilename(Filefilter:="Excel(*.xls), *.xls", _
Title:="Bitte Dienstplan des Vormonats öffnen")
If varAuswahl = False Then GoTo Beenden
'Vormonatsdatei schreibgeschützt öffnen
Set wbVormonat = Application.Workbooks.Open(Filename:=varAuswahl, ReadOnly:=True)
Set wksDienstVor = wbVormonat.Worksheets("Dienstplan")
Set wksKopfVor = wbVormonat.Worksheets("Kopf")
'Vergleich Monat und Jahr im Blatt Kopf der beiden Dateien
Select Case wksKopf.Range("c1")
Case 1 'Januar
If wksKopfVor.Range("c1") = 12 _
And Year(wksKopf.Range("c2")) - Year(wksKopfVor.Range("c2")) = 1 Then
bolPruefung = True
End If
Case 2 To 12 'Februar - Dezember
If wksKopf.Range("c1") - wksKopfVor.Range("c1") = 1 _
And Year(wksKopf.Range("c2")) = Year(wksKopfVor.Range("c2")) Then
bolPruefung = True
End If
Case Else
MsgBox "Unzulässige Eingabe für Monat oder Datum im Blatt Kopf"
GoTo Beenden
End Select
If bolPruefung = True Then
'Daten aus Vormonatsblatt einlesen _
Spaltennummern sowie Werte für Offset anpassen!!!!
With wksDienst 'Blatt in das eingetragen werden soll
.Unprotect
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
lngSpalte = 34 'Spalte AH = Zielspalte für Saldodaten aus Vormonat im Dienstplan
lngSpalteVor = 35 'Spalte AI = Quellspalte mit Saldodaten aus Vormonat
For lngMit = 1 To intMitarbeiter
'in den nachfolgenden Zeilen die Bezugszeilen für die Werte eingeben _
falls auch die Spalten und Offsetwerte variieren, dann müssen diese ebenfalls _
in den Case-Zeilen als Variablen festgelegt werden und unten in den Anweisungen _
für das Eintragen der Werte die Zahlen durch die entsprechenden Variablen ersetzt _
werden.
Select Case lngMit
Case 1: lngZeile = 7
Case 2: lngZeile = 37
Case 3: lngZeile = 67
Case 4: lngZeile = 97
Case 5: lngZeile = 127
Case 6: lngZeile = 157
Case 7: lngZeile = 187
Case 8: lngZeile = 217
Case 9: lngZeile = 247
Case 10: lngZeile = 277
Case 11: lngZeile = 307
Case 12: lngZeile = 337
Case 13: lngZeile = 367
Case 14: lngZeile = 397
Case 15: lngZeile = 327
Case 16: lngZeile = 357
Case 17: lngZeile = 387
Case 18: lngZeile = 417
Case 19: lngZeile = 447
Case 20: lngZeile = 477
Case 21: lngZeile = 507
Case 22: lngZeile = 537
Case 23: lngZeile = 567
Case 24: lngZeile = 597
Case Else
MsgBox "Für Mitarbeiter nr. " & intMit _
& " wurde noch keine Case-Zeile im Code angelegt"
End Select
'Wert 1 übernehmen
.Cells(lngZeile, lngSpalte).Offset(0, 0).Value = _
wksDienstVor.Cells(lngZeile, lngSpalteVor).Offset(0, 0).Value
'Wert 2 übernehmen
.Cells(lngZeile, lngSpalte).Offset(1, 0).Value = _
wksDienstVor.Cells(lngZeile, lngSpalteVor).Offset(1, 0).Value
'Wert 3 übernehmen
.Cells(lngZeile, lngSpalte).Offset(2, 0).Value = _
wksDienstVor.Cells(lngZeile, lngSpalteVor).Offset(2, 0).Value
Next
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
.Protect
End With
Else
MsgBox "Die geöffnete Datei enthält nicht Daten des Vormonats"
End If
Fehler:
If Err.Number 0 Then
strMsg = "Fehler-Nr. " & Err.Number & vbLf & Err.Description
If Not wbVormonat Is Nothing And wksDienstVor Is Nothing Then
strMsg = strMsg & vbLf & "Blatt ""Dienstplan"" in geöffneter Datei nicht vorhanden"
ElseIf Not wbVormonat Is Nothing And wksKopfVor Is Nothing Then
strMsg = strMsg & vbLf & "Blatt ""Kopf"" in geöffneter Datei nicht vorhanden"
End If
MsgBox strMsg
End If
Beenden:
If Not wbVormonat Is Nothing Then
If MsgBox("Soll geöffnete Datei mit Daten des Vormonats wieder geschlossen werden?", _
vbYesNo) = vbYes Then wbVormonat.Close savechanges:=False
End If
End Sub
Also genau so sollte das sein, Vielen Dank. Kompliment das du dich in eine wie ich finde komplexe Excel Mappe so gut reindenken konntest.
Einen kleinen schönheitsfehler gibt es noch, er liest nur den ersten Wert aus, die anderen beiden offset anweisungen bearbeitet er zwar hat aber hat kein Ergebnis was er in die Zellen einträgt. Zur Zeit habe ich das makro 3 mal kopiert und die Zellinformation an der Stelle für den ersten Wert in der 2 u 3 kopie abgeändert und starte das ganze mit einem call makro. Da nervt dann beim 2 und 3 mal diese (ehrlich super gelöste) Dateiimport öffnen Lösung.