Makro Datumsabfrage+Sheet copy
05.11.2006 10:04:08
Michael
Wie bereits in einem anderen Beitrag geschrieben bin ich LearningByDoing-User ohne VBA-Hintergrund und habe ein Makro geschrieben, dass das monatliche Ersetzen der Bezüge dieser 31 mal(für jeden Tag) vorkommenden Formel automatisiert:
=WENN(ISTFEHLER(SVERWEIS(B17;'C:\Dokumente und Einstellungen\compass\Desktop\COBA\Abrechnung\[FB-18 Barausgabenliste.xls]Nov.06'!$A$14:$H$35;7;FALSCH));SVERWEIS(1;'C:\Dokumente und Einstellungen\compass\Desktop\COBA\Abrechnung\[FB-15 Kontrollblatt Kreditkkarten.xls]Nov.06'!$A$16:$F$46;6);(SVERWEIS(1;'C:\Dokumente und Einstellungen\compass\Desktop\COBA\Abrechnung\[FB-15 Kontrollblatt Kreditkkarten.xls]Nov.06'!$A$16:$F$46;6))-(SVERWEIS(B17;'C:\Dokumente und Einstellungen\compass\Desktop\COBA\Abrechnung\[FB-18 Barausgabenliste.xls]Nov.06'!$A$14:$H$35;7;FALSCH)))
So sieht das Makro aus:
Private Sub CommandButton1_Click()
j2 = InputBox("Geben Sie die LETZTEN ZWEI STELLEN des AKTUELLEN Jahres ein:" & vbCr & vbCr & vbCr & vbCr & "***Beispiel: 07 ***")
Z1 = InputBox("Geben Sie den aktuellen Monat in Zahlen ein:" & vbCr & vbCr & vbCr & vbCr & "***Beispiel: März = 3, Dezember = 12 ***")
j1 = 2000 + j2
jw = j2 + 1
If Z1 = "1" Then GoTo Januar
If Z1 = "2" Then GoTo Februar
If Z1 = "3" Then GoTo März
If Z1 = "4" Then GoTo April
If Z1 = "5" Then GoTo Mai
If Z1 = "6" Then GoTo Juni
If Z1 = "7" Then GoTo Juli
If Z1 = "8" Then GoTo August
If Z1 = "9" Then GoTo September
If Z1 = "10" Then GoTo Oktober
If Z1 = "11" Then GoTo November
If Z1 = "12" Then GoTo Dezember Else GoTo abbruch2
Januar:
With Range("b17")
.Value = DateSerial(j1, Z1 + 1, 1)
Cells.Replace What:="Jan." & j2, Replacement:="Feb." & j2, LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False
End With
Exit Sub
Februar:
With Range("b17")
.Value = DateSerial(j1, Z1 + 1, 1)
Cells.Replace What:="Feb." & j2, Replacement:="März." & j2, LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False
End With
Exit Sub
März:
With Range("b17")
.Value = DateSerial(j1, Z1 + 1, 1)
Cells.Replace What:="März." & j2, Replacement:="April." & j2, LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False
End With
Exit Sub
April:
With Range("b17")
.Value = DateSerial(j1, Z1 + 1, 1)
Cells.Replace What:="April." & j2, Replacement:="Mai." & j2, LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False
End With
Exit Sub
Mai:
With Range("b17")
.Value = DateSerial(j1, Z1 + 1, 1)
Cells.Replace What:="Mai." & j2, Replacement:="Juni." & j2, LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False
End With
Exit Sub
Juni:
With Range("b17")
.Value = DateSerial(j1, Z1 + 1, 1)
Cells.Replace What:="Juni." & j2, Replacement:="Juli." & j2, LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False
End With
Exit Sub
Juli:
With Range("b17")
.Value = DateSerial(j1, Z1 + 1, 1)
Cells.Replace What:="Juli." & j2, Replacement:="Aug." & j2, LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False
End With
Exit Sub
August:
With Range("b17")
.Value = DateSerial(j1, Z1 + 1, 1)
Cells.Replace What:="Aug." & j2, Replacement:="Sept." & j2, LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False
End With
Exit Sub
September:
With Range("b17")
.Value = DateSerial(j1, Z1 + 1, 1)
Cells.Replace What:="Sept." & j2, Replacement:="Okt." & j2, LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False
End With
Exit Sub
Oktober:
With Range("b17")
.Value = DateSerial(j1, Z1 + 1, 1)
Cells.Replace What:="Okt." & j2, Replacement:="Nov." & j2, LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False
End With
Exit Sub
November:
With Range("b17")
.Value = DateSerial(j1, Z1 + 1, 1)
Cells.Replace What:="Nov." & j2, Replacement:="Dez." & j2, LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False
End With
Exit Sub
Dezember:
With Range("b17")
.Value = DateSerial(j1, Z1 + 1, 1)
Cells.Replace What:="Dez." & j2, Replacement:="Jan.0" & jw, LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False
End With
Exit Sub
abbruch2:
MsgBox "Das Ersetzen wird abgebrochen, bitte nur gültige Zahlen eintragen!", vbInformation + vbOKOnly, "Information"
End Sub
Noch offene Fragen:
Beim Jahreswechsel, wenn sich der Sheetname von Dez.06 in Jan.07 ändert, habe ich mit der Formel jw = j2 + 1 das Problem, dass JW dann nur noch einstellig ist. Deshalb ist die Formel dort:
Code:
Cells.Replace What:="Dez." & j2, Replacement:="Jan.0" & jw, LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False
Kann ich mir mit irgendeinem Format-Befehl die 0 hinter "Jan." schenken? Dann wäre die Formel länger tauglich und nicht nur bis 2010.
Und ganz raffiniert wäre noch, wenn ich irgendwie eine Abfrage einbauen könnte, die bei Auslösen des Buttons das eingegebene Datum mit dem gerade aktuellen Datum abgleicht und bei einer Differenz von über zwei Monaten oder so mit einer Messagebox nachhakt. Geht sowas?
Dann eine Frage zum Kopieren und dahinter Einfügen inkl. Umbenennen des neuen Sheets vor dem Ersetzen aller Bezüge, was ja auch monatlich anfällt.
Die Sheets heissen, wie auch alle anderen, die damit verknüpft sind Jan.06, Feb.06 usw...
Ich habe jetzt mal versucht, das Ganze so zu lösen(was überhaupt nicht funktioniert):
Code:
sh = ((j2 - 7) * 12) + (z1 - 2)
...
Januar:
ActiveSheet.Copy After:=Sheets(sh)
ActiveSheet.Select
ActiveSheet.Name = "Feb." & j2
mit dem sh wollte ich die jeweils aktuelle Anzahl der Sheets repräsentieren, allerdings kommt die Formel garnicht bis dorthin, weshalb ich nicht weiss, ob das so funktioniert.
Gibt es für dieses Problem eine Lösung?
Ich muss noch dazusagen, dass ich meine verformelten Arbeitsblätter meinen Nachfolgern in ehemaligen Betrieben hinterlasse und das Ersetzen via Telefon teilweise sehr mühsam ist, da auch teilweise keine PC-Kenntnisse vorhanden sind. Auch deshalb würde ich das gern automatisieren.