VBA - Auf jeweiligen Monat springen

[Der Steuerfuzzi]

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

[RPP63]

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

[snb]

Klicke in Spalte E das gewünschte Monat

[joshua]

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?

[Der Steuerfuzzi]

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.

[RPP63]

Moin Michael!
Vorweg, ist keine Kritik an Deiner Lösung, sondern nur eine Ergänzung.

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:

1. Du setzt die nicht flüchtigen Parameter LookIn:= und LookAt:= nicht neu.
   
2. 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

[Der Steuerfuzzi]

Hi Ralf,

[*]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.

[RPP63]

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_timer

Option 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 Modul2

Option 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

[joshua]

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?

[Der Steuerfuzzi]

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.
...