Bereich festlegen will nicht

Hallo Helfende
Mit folgenden Code will ich einen Bereich zum weiterverarbeiten festlegen. Bis zum Anlegen des Bereiches funkt alles.
In der Zeile "rngBereich=" löst den Fehler: "Objektvariable oder With-Blockvariable nicht festgelegt" aus.
Option Explicit


Private Sub Worksheet_Change(ByVal Target As Range)
Dim strDat As Date, Treffer As Range, rngBereich As Range
Dim iEnd As Integer, iStart As Integer
strDat = NächsterSonntag(Cells(1, Target.Column))
Set Treffer = Range(Cells(3, Target.Column), Cells(3, Target.Column + 14)).Find(what:=strDat)
iEnd = Treffer.Column + 1
iStart = Treffer.Column - 12
rngBereich = Range(Cells(3, iStart), Cells(3, iEnd)).Address
Set Treffer = Nothing
End Sub


Private Function NächsterSonntag(Datum As Date)
NächsterSonntag = FormatDateTime(Datum + (8 - Weekday(Datum)))
End Function

Gruß
Lorenz

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Hi Lorenz,
folgender Test funktioniert nur, wenn der Lattenzaun in Zeile 200 nicht da ist. Dazu musst Du unter Zellen Formatieren - Ausrichtung - den Haken bei An Zellgröße anpassen setzen.

Sub test() Dim d As Date, C As Range d = DateSerial(2021, 1, 10) Set C = Rows(200).Find(what:=d, LookIn:=xlValues, lookat:=xlWhole) MsgBox C.Address End Sub

Fazit: Es hat auch irgendwas mit der Ansicht / dem Zellformat zu tun.
Aber ich bekomme das in Deinem Change-Ereignis zum Verrecken nicht zum Laufen - auch nicht mit Umwandlungsfunktionen (CLng, CDate) oder mit der Format-Funktion und englischer Datumsschreibweise usw. usw.
Ich stell auf offen - oder Du eröffnest dazu einen neuen Thread.
Sorry!
VG, Boris

Private Sub Worksheet_Change(ByVal Target As Range) Dim strDat As Date, Treffer As Range, rngBereich As Range Dim strDat As Date, Treffer As Range, rngBereich As Range Dim iEnd As Integer, iStart As Integer Dim LSp As Integer, j As Integer, AC As Range LSp = Cells(200, Columns.Count).End(xlToLeft).Column '739 Spalten!! If Target.Column > 10 And Target.Column LSp Then MsgBox strDat & " Datum nicht gefunden": Exit Sub AC.Select 'nur zum testen MsgBox AC.Address Exit Sub '** nur zum testen iEnd = Treffer.Column + 1 iStart = Treffer.Column - 12 rngBereich = Range(Cells(3, iStart), Cells(3, iEnd)).Address Set Treffer = Nothing End Sub

Private Sub Worksheet_Change(ByVal Target As Range) Dim strDat As Date, Treffer As Range, rngBereich As Range Dim iEnd As Integer, iStart As Integer strDat = NächsterSonntag(Cells(1, Target.Column)) Set Treffer = Range(Cells(3, Target.Column), Cells(3, Target.Column + 14)).Find(what:=CDate(strDat), LookIn:=xlValues) If Treffer Is Nothing Then MsgBox strDat & " Kein Treffer gefunden": Exit Sub iEnd = Treffer.Column + 1 iStart = Treffer.Column - 12 'MsgBox Treffer.Address 'MsgBox CStr(Range(Cells(3, iStart), Cells(3, iEnd)).Address) 'MsgBox Range(Cells(3, iStart), Cells(3, iEnd)).Address Set rngBereich = Range(Cells(3, iStart), Cells(3, iEnd)) MsgBox rngBereich.Address Set Treffer = Nothing End Sub

Beliebteste Forumthreads (12 Monate)

17 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

17
Beiträge zum Forumthread

Beiträge zu diesem Forumthread