' Skript zum Berechnen der Monate eines Jahres die einen bestimmten Tag enthalten
' Bsp.: In welchen Monaten (des Jahres 2001) gab es einen Freitag den 13.
' (c) by Andreas Kästner  20-Jun-2005
' http://a-kaestner.de  andreaskaestner@web.de
' Version 1.1  28-Jun-2005

Option Explicit
Dim inp, result, help

help = "Enter day, number, year" & vbCRLF & _
       "Example: Friday 13 2005" & vbCRLF & _
       "omit year ==> assume current year" & vbCRLF & vbCRLF & _
       "Eingabe: Tag Zahl Jahr" & vbCRLF & _
       "Beispiel: Freitag 13 2005" & vbCRLF & _
       "ohne Jahresangabe ==> aktuelles Jahr" & vbCRLF & vbCRLF

Do
  inp = Trim(InputBox(help & result, "Find Months", inp))
  result = ""
  If inp <> "" Then FindMonths inp
Loop Until inp = ""

WScript.Quit

Sub FindMonths(str)
Dim wrk, datearr, i, wday

  datearr = Split(str)
  i = UBound(datearr)
  If i = 1 Then
    ReDim Preserve datearr(i+1)
    datearr(2) = Year(Date)
  End If
  datearr(0) = UCase(Left(datearr(0), 1)) & _
               LCase(Mid(datearr(0), 2, Len(datearr(0))))
  datearr(1) = Replace(UCase(datearr(1)), "ST", "")
  datearr(1) = Replace(UCase(datearr(1)), "ND", "")
  datearr(1) = Replace(UCase(datearr(1)), "RD", "")
  inp = datearr(0) & " " & datearr(1) & " " & datearr(2)

  Select Case UCase(Left(datearr(0), 2))
    Case "SU","SO" : wday = 1	' sunday, sonntag
    Case "MO","MO" : wday = 2	' monday, montag
    Case "TU","DI" : wday = 3	' tuesday, dienstag
    Case "WE","MI" : wday = 4	' wednesday, mittwoch
    Case "TH","DO" : wday = 5	' thursday, donnerstag
    Case "FR","FR" : wday = 6	' friday, freitag
    Case "SA","SA" : wday = 7	' saturday, samstag
  End Select
  For i = 1 To 12
    wrk = datearr(1) & "-" & i & "-" & datearr(2)
    If DatePart("w", wrk) = wday Then
      result = result & datearr(0) & " " & wrk & vbCRLF
    End If
  Next

End Sub