Die Buttons kann man übrigens auch automatisch erzeugen, z.B. so:
Code:
Sub ButtonsErstellen()
Dim btn As Object
Dim i As Long
For i = 1 To 12
Set btn = ActiveSheet.Buttons.Add(1 + (i - 1) * 30, 105, 30, 15)
btn.OnAction = "Springen"
btn.Caption = Format(DateSerial(1, i, 1), "MMM")
btn.Name = Format(DateSerial(1, i, 1), "MMM")
Next
End Sub
Da ich hier für die Namen der Buttons die Monatsnamen hinterlege, kann man das erste Makro etwas kürzen:
Code:
Sub Springen()
ActiveSheet.Range("10:10").Find(CDate("1. " & Application.Caller & " " & Year(Range("E10")))).Select
End Sub
Moin und nur am Rande … ;)
Wenn ich doch weiß, dass ich übermorgen einen Termin habe, muss ich den doch nicht erst finden, sondern ahne, dass er in zwei Tagen ist.
Stetige Datenreihe in Zeile 10;
dann ist der 1.8. doch Spalte
DateSerial(2018, 8, 1) - DateSerial(2018, 1, 0)
also 213
Two Cents
vom ollen
Ralf
Klicke in Spalte E das gewünschte Monat
(10.01.2018, 14:18)Der Steuerfuzzi schrieb: [ -> ]Code:
Sub Springen()
ActiveSheet.Range("10:10").Find(CDate("1. " & ActiveSheet.Buttons(Application.Caller).Caption & " " & Year(Range("E10")))).Select
End Sub
Merci! Super Ansatz, funktioniert wunderbar.
Wie schaut es aus, wenn ich Spalte A:E fixiert habe und per Klick jeweils der 01. vom Monat ganz links neben E angezeigt werden soll?
Versuch es mal so:
Code:
Sub Springen()
' ActiveSheet.Range("10:10").Find(CDate("1. " & Application.Caller & " " & Year(Range("F10")))).Select
ActiveWindow.ScrollColumn = ActiveSheet.Range("10:10").Find(CDate("1. " & Application.Caller & " " & Year(Range("F10")))).Column
End Sub
@Ralf: Du hast sicherlich recht, dass man die Spalte auch per Formel ermitteln kann. Für mich macht es aber keinen großen Unterschied, ob man die Zelle per Find oder per Berechnung findet. Es ist mE weder zeitkritisch noch nachteilig. Zudem lehrt mich die Erfahrung, dass auf einmal etwas nicht mehr funktioniert, wenn man z.B. nach den Monaten Summen einfügt. Mit Find habe ich (zumindest das) Problem nicht.
Moin Michael!
Vorweg, ist keine Kritik an Deiner Lösung, sondern nur eine Ergänzung.
(11.01.2018, 08:14)Der Steuerfuzzi schrieb: [ -> ]Für mich macht es aber keinen großen Unterschied, ob man die Zelle per Find oder per Berechnung findet. Es ist mE weder zeitkritisch noch nachteilig.
Sicherlich richtig, was den Zeitfaktor angeht.
Find ist zwar erheblich langsamer (dürfte so ca. der Faktor 100 sein), ist bei
einer Suche aber vollkommen unerheblich.
Wichtiger empfinde ich zwei Sachen:
- Du setzt die nicht flüchtigen Parameter LookIn:= und LookAt:= nicht neu.
- Range.Find bekommt Probleme, wenn die Daten ein "exotisches" Zahlenformat haben.
Aus
meiner Erfahrung ist es besser WorksheetFunction.Match() mit dem 3. Argument 0 zu nehmen, wenn man nicht "simpel" rechnen kann.
Gruß Ralf
Hi Ralf,
(11.01.2018, 08:35)RPP63 schrieb: [ -> ][*]Du setzt die nicht flüchtigen Parameter LookIn:= und LookAt:= nicht neu.
[*]Range.Find bekommt Probleme, wenn die Daten ein "exotisches" Zahlenformat haben.
Bei Punkt 1 stimme ich Dir vollkommen zu, das sollte korrekt gesetzt werden. Hier die angepaste Funktion:
Code:
Sub Springen()
ActiveWindow.ScrollColumn = ActiveSheet.Range("10:10").Find(CDate("1. " & Application.Caller & " " & Year(Range("F10"))), , xlFormulas, xlPart).Column
End Sub
Bei Punkt 2 hatte ich beim einem Datum noch nie Probleme, egal wie es formatiert war.
Problematisch an meiner Lösung wäre noch, dass ich bei Find nicht geprüft habe, ob der Wert überhaupt vorkommt. Denn wenn der Wert nicht fegunden wird, dann erfolgt ein Select bzw. bei der zweiten Variante das Row einen Fehler aus.
Ich hatte mal ein wenig Langeweile.
Und ja! Ist eine eher akademische Diskussion. ;)
Zunächst der bekannte Microtimer, weil wir über sehr kleine Zeiträume reden:
Modul Micro_timerOption Explicit
#If VBA7 Then
Private Declare PtrSafe Function getFrequency Lib "kernel32" Alias _
"QueryPerformanceFrequency" (cyFrequency As Currency) As Long
Private Declare PtrSafe Function getTickCount Lib "kernel32" Alias _
"QueryPerformanceCounter" (cyTickCount As Currency) As Long
#Else
Private Declare Function getFrequency Lib "kernel32" Alias _
"QueryPerformanceFrequency" (cyFrequency As Currency) As Long
Private Declare Function getTickCount Lib "kernel32" Alias _
"QueryPerformanceCounter" (cyTickCount As Currency) As Long
#End If
Public Function Microtimer() As Double
Dim cyTicks1 As Currency
Static cyFrequency As Currency
Microtimer = 0
If cyFrequency = 0 Then getFrequency cyFrequency
getTickCount cyTicks1
If cyFrequency Then Microtimer = cyTicks1 / cyFrequency
End Function
Nun der Unterschied zwischen Find und Errechnen.
Find ist schlappe 16.500mal langsamer.
Teste an einem leeren Sheet:
Modul Modul2Option Explicit
Sub Find_vs_Calculate()
Dim Start#, i&, m&
Dim Datum As Range
'Vorbereitung der Datenreihe
With Range("A1:A100000")
.Clear
.Formula = "=DATE(2000,1,ROW())"
.Copy: .PasteSpecial xlPasteValues
Application.CutCopyMode = False
Application.Goto .Cells(1)
End With
'Monate ermitteln (sind 1076)
m = DateDiff("m", Range("A1"), Range("A100000"))
'Range.Find -Methode
Start = Microtimer
For i = 1 To m
Set Datum = Range("A1:A100000").Find(DateSerial(2000, i, 1), , xlValues, xlWhole)
Next
Debug.Print Microtimer - Start '31,3 Sekunden
'Rechen-Methode
Start = Microtimer
For i = 1 To m
Set Datum = Cells(DateSerial(2000, i, 1) - DateSerial(2000, 1, 0), 1)
Next
Debug.Print Microtimer - Start ' 0,0019 Sekunde
End Sub
Gruß Ralf
Hallo Steuerfuzzi,
vielen Dank für deine Unterstützung!
Leider erhalte ich mit dem Code deiner beiden letzten beiden Beiträge nur eine Fehlermeldung "Typen unverträglich".
Woran mag das liegen?
Ich kenne Deine Datei nicht, ich kann nur raten.
Es könnte sein, dass der Button nicht richtig benannt ist.
Es könnte sein, dass es keion Button ist.
Es könnte sein, dass in Zelle F10 kein oder kein richtiges Datum steht.
Es könnte sein, dass das Datum, zu dem Du springen willst, nicht existiert.
...