Datum finden ....
Berndi
Ich habe ein Problem damit in einem selbst generierten Kalender bestimmte Felder zu suchen, die ein gewisses Datum tragen.
Die Datumsfelder in dem Kalender generiere ich hiermit:
<code>
Datum = "1/1/" & Jahr
For I = 1 To 12
If month(Datum) = 1 Or month(Datum) = 3 Or month(Datum) = 5 Or month(Datum) = 7 Or month(Datum) = 8 Or month(Datum) = 10 Or month(Datum) = 12 Then
MLaenge = 31
Else
MLaenge = 30
If month(Datum) = 2 Then
If Schaltjahr Then
MLaenge = 29
Else
MLaenge = 28
End If
End If
End If
If month(Datum) < 7 Then
PosY = 3
PosX1 = 1 + ((month(Datum) - 1) * 32)
Else
PosY = 21
PosX1 = 1 + ((month(Datum) - 7) * 32)
End If
For PosX = PosX1 To PosX1 + MLaenge - 1
'Tage updaten und einfärben
If WeekDay(Datum, vbSunday) = 1 Or WeekDay(Datum, vbSunday) = 7 Then
Worksheets(Seitenname).Cells(PosY, PosX).Interior.ColorIndex = 22
Else
Worksheets(Seitenname).Cells(PosY, PosX).Interior.ColorIndex = 20
End If
Worksheets(Seitenname).Cells(PosY, PosX).Value = Datum
Datum = Datum + 1
Next
</code>
~f~
Die Datumsfelder werden zentriert und 90° verdreht formatiert
Jetzt möchte ich aus dem Internet die Ferientage auslesen, diese in dem Kalender suchen und dann irgendwie formatieren, doch egal was ich anstelle, keine Funktion findet das entsprechende Feld.
Hiermit versuche ich das zu bewerkstelligen:
~f~
<code>
<pre>Sub Ferienimport()
'Worksheets(Seitenname).QueryTables("Schulferien").Delete
If Jahr - Year(Date) = 0 Or Jahr - Year(Date) = 1 Or Jahr - Year(Date) = -1 Then
With Worksheets(Seitenname).QueryTables.Add(Connection:="URL;http://www.schulferien.org/Hessen/hessen.html", Destination:=Range("GK1"))
.Name = "Schulferien"
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = False
.RefreshOnFileOpen = False
.BackgroundQuery = False
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = False
.RefreshPeriod = 0
.WebSelectionType = xlSpecifiedTables
.WebFormatting = xlWebFormattingNone
.WebTables = "7"
.WebPreFormattedTextToColumns = True
.WebConsecutiveDelimitersAsOne = True
.WebSingleBlockTextImport = False
.WebDisableDateRecognition = False
.WebDisableRedirections = False
.Refresh BackgroundQuery:=False
End With
Worksheets(Seitenname).Cells(1, 1).Select
With Worksheets(Seitenname).Columns(193)
Set Z = .Find(Jahr, LookIn:=xlValues)
If Not Z Is Nothing Then
Oster_A = Left(Worksheets(Seitenname).Cells(Z.Row, 195).Value, 6)
Oster_E = Right(Worksheets(Seitenname).Cells(Z.Row, 195).Value, 6)
Sommer_A = Left(Worksheets(Seitenname).Cells(Z.Row, 197).Value, 6) & Jahr
Sommer_E = Right(Worksheets(Seitenname).Cells(Z.Row, 197).Value, 6) & Jahr
Herbst_A = Left(Worksheets(Seitenname).Cells(Z.Row, 198).Value, 6) & Jahr
Herbst_E = Right(Worksheets(Seitenname).Cells(Z.Row, 198).Value, 6) & Jahr
XMas_A = Left(Worksheets(Seitenname).Cells(Z.Row, 199).Value, 6) & Jahr
XMas_E = Right(Worksheets(Seitenname).Cells(Z.Row, 199).Value, 6) & Jahr
XMas_Ealt = Right(Worksheets(Seitenname).Cells(Z.Row - 1, 199).Value, 6) & Jahr
End If
End With
Range("GK1:GQ17").Delete Shift:=xlToLeft
MsgBox (Oster_A & Chr(13) & Oster_E)
'Worksheets(Seitenname).Cells(100, 1).Value = Oster_A
'Oster_A = Worksheets(Seitenname).Cells(100, 1).Value
'MsgBox (Oster_A & Chr(13) & Oster_E)
With Worksheets(Seitenname).Range("A1:GJ35")
Set Z = .Find(Oster_A, LookIn:=xlFormulas)
If Not Z Is Nothing Then
MsgBox ("Gefunden: " & Z.Column)
'Worksheets(Seitenname).Range(Z.Range).Select
End If
End With
End If
MsgBox (Year(Date) & Chr(13) & Jahr)
End Sub</pre>
</code>
Kann mir jemand von Euch bei der Problemlösung helfen ?
LG,
Berndi