VBA - Datum aus Range mit Offset suchen

Question

Liebe Community,

da mir hier schon einige Male schnell geholfen wurde, wäre ich begeistert, wenn dies noch einmal klappt.

Ich arbeite an einem Skript zur Aufarbeitung von Daten (Umformatierung eines festen Layouts mit variabler Länge).

Dafür ist u.a. eine Spalte "EventDay" nötig (diese läuft von -5 bis +5). Diese lasse ich aktuell durch eine Schleifenkonstruktion laufen (keine Schleifendiskussion an dieser Stelle - es ist nicht elegant, aber muss erstmal laufen, da Zeitdruck herrscht).

Nun hatte ich bis vor kurzem eine Spalte "EventDate", die das echte Datum anzeigt. Diese Spalte wurde gefüllt, indem das Basisdatum (bspw. 01.10.2017) aus einer dritten Zelle genommen wird.

Die Daten oberhalb und unterhalb habe ich per Schleife -5 + i (i++) eingetragen, indem ich vom EventDate einfach den EventDay abziehe/hinzurechne.

Nun habe ich aber festgestellt, dass ich Feiertage und Wochenenden auf diese Weise nicht berücksichtigen kann.

Deshalb habe ich eine zweite Datei aus welcher ich die Daten bereinigt entnehmen kann. Sozusagen rngDateImport

Per UsedRange habe ich diese Spalte in einer Range gespeichert und möchte jetzt wie folgt vorgehen:

Ich möchte aus rngDateImport die Zelle EventDate=0 (hier also 01.10.2017) suchen und dann die Zellen EventDate (-5 bis +5) mit den Werte aus rngDateImport (-5 bis +5 um EventDate 0).

Wie stelle ich dies am geschicktesten an? Ich kann den Code unten posten.

    Dim wbkDates As Workbook

    Dim wksDates As Worksheet

    Dim varFile As Variant

    Dim rngDates As Range

    Dim rngDate As Range

    varFile = Application.GetOpenFilename("Excel Files (*.xls; *.xlsx; *.xlsm; *.csv; *.xlt; *.xlst; *.xlm),*.xls; *.xlsx; *.xlsm; *.csv; *.xlt; *.xlst; *.xlm", , , , False)

        If varFile = False Then

            Exit Sub

        Else

            Set wbkDates = Workbooks.Open(varFile)

        End If

    Set rngDates = wbkDates.ActiveSheet.UsedRange

    wbkDates.Close (False)

    intCounterDateV = p_intCounterDateV

    intCounterH = wksIn.UsedRange.Columns.Count

    Debug.Print intCounterDateV

    Debug.Print intCounterH

    intTempI = 1

    intTempII = 1

    intTempIII = 0

    lngTempIV = 1

    Do Until intTempI = intCounterH

        m_varSplitHeaderCell = Split(wksIn.Cells(1, intTempI + 1), " ")

        m_strISIN = UCase(m_varSplitHeaderCell(1))

        varEventDay = Split(m_varSplitHeaderCell(2), "/")

        m_datEventDay = varEventDay(1) & "." & varEventDay(0) & "." & varEventDay(2)

           Do Until intTempII = intCounterDateV

                wksOut.Cells(intTempII + lngTempIV, 1) = m_strISIN

                wksOut.Cells(intTempII + lngTempIV, 4) = wksIn.Cells(intTempII + 1, intTempI + 1)

                wksOut.Cells(intTempII + lngTempIV, 3) = p_intRDLB + intTempIII

                wksOut.Cells(intTempII + lngTempIV, 2) = HIER WÄRE DAS DATUM EventDate ANZUZUZEIGEN

                intTempII = intTempII + 1

                intTempIII = intTempIII + 1

            Loop

        lngTempIV = lngTempIV + intTempII - 1

        intTempII = 1

        intTempIII = 0

        intTempI = intTempI + 1

    Loop

Ich bedanke mich vorab für eure Unterstützung!

Ich hatte bereits mit der Methode .Find versucht zu arbeiten. Oder aber auch  mit Cells(find,1).Offset, aber komme einfach nicht weiter.

VG

Florian

Answer 1

Hallo Florian,

besser so:

With wbkDates.ActiveSheet
    Set rngDateI = .Range("A:A").Find(m_datEventDay)
    varDates = .Range("A" & rngDateI.Row).Offset(-5).Resize(11)
End With
wbkDates.Close (False)

Claus

Answer 2

Hallo Florian,

sorry, habe eine Zelle vergessen zu kopieren:

If varFile = False Then
            Exit Sub
        Else
            Set wbkDates = Workbooks.Open(varFile)
        End If
Set rngDatesI = wbkDates.ActiveSheet.UsedRange
Set rngDateI = rngDatesI.Range("A:A").Find(m_datEventDay)
varDates = rngDatesI.Range("A" & rngDateI.Row).Offset(-5).Resize(11)
wbkDates.Close (False)

Claus

Answer 3

Hallo Florian,

wenn du das Workbook schließt, ist der Range nicht mehr definiert.

Ändere die Reihenfolge:

If varFile = False Then
      Exit SubElse
      Set wbkDates = Workbooks.Open(varFile)
End IfSet rngDatesI = wbkDates.ActiveSheet.UsedRange
Set rngDateI = rngDatesI.Range("A:A").Find(m_datEventDay)
varDates = rngDatesI.Range("A" & rngDateI.Row).Offset(-5).Resize(11)
wbkDates.Close (False)

Claus

Answer 4

Hallo Florian,

ich verstehe deine Ausführung nicht richtig.

Aber hier mal ein Beispiel für Datumswerte, die in Spalte E stehen und das Suchdatum in K2 steht. Das Datum wird gesucht und mit Offset 5 Zeilen oberhalb ein Array aus 10 Datumswerten eingelesen:

Dim c As Range
Dim varDates As Variant

Set c = Range("E:E").Find(Range("K2"))
varDates = Range("E" & c.Row).Offset(-5).Resize(10)

Dann kannst du dir die Werte aus dem Array auslesen. Beachte aber, dass das Array 2-dimensional ist. Der erste Werte ist also varDates(1,1).

Claus

Answer 5

Hi Claus,

du bist ja richtig aktiv hier.

Besten Dank für den Ansatz. Ich habe allerdings weiterhin denselben Fehler, wie vorher

Die Zeile 

Set rngDateI = rngDates.I.Range("A:A")Find(m_datEventDay)

liefert "Object required 424".

Es scheint ein Problem mit der Methode .Find und der Variablen m_datEventDay.

Den Code poste ich jetzt mal ganz drunter.

Am Ende soll es so aussehen, wie auf dem Screenshot. Vllt kannst du dann meinem Text eher folgen. Bin leider nicht ganz so VBA-fest - recht neu in der Materie und deshalb manchmal etwas konfus.

Besten Dank für deine Hilfe!

VG

Florian

    'variables for statements / loops

    Dim intTempI As Integer

    Dim intTempII As Integer

    Dim intTempIII As Integer

    Dim lngTempIV As Long

    'settings used worksheets

    Set wksIn = Worksheets("Input")

    Set wksOut = Worksheets("Output")

    'setting UsedRange input and counter

    Set rngUsedRangeIn = wksIn.UsedRange

    intUsedRangeInHCount = rngUsedRangeIn.Columns.Count

    'Import Dates

    Dim wbkDates As Workbook

    Dim wksDates As Worksheet

    Dim varFile As Variant

    Dim rngDatesI As Range

    Dim rngDateI As Range

    Dim varDateO As Variant

    varFile = Application.GetOpenFilename("Excel Files (*.xls; *.xlsx; *.xlsm; *.csv; *.xlt; *.xlst; *.xlm),*.xls; *.xlsx; *.xlsm; *.csv; *.xlt; *.xlst; *.xlm", , , , False)

        If varFile = False Then

            Exit Sub

        Else

            Set wbkDates = Workbooks.Open(varFile)

        End If

    Set rngDatesI = wbkDates.ActiveSheet.UsedRange

    wbkDates.Close (False)

    intCounterDateV = p_intCounterDateV

    intCounterH = wksIn.UsedRange.Columns.Count

    Debug.Print intCounterDateV

    Debug.Print intCounterH

    intTempI = 1

    intTempII = 1

    intTempIII = 0

    lngTempIV = 1

    Do Until intTempI = intCounterH

        m_varSplitHeaderCell = Split(wksIn.Cells(1, intTempI + 1), " ")

        m_strISIN = UCase(m_varSplitHeaderCell(1))

        varEventDay = Split(m_varSplitHeaderCell(2), "/")

        m_datEventDay = varEventDay(1) & "." & varEventDay(0) & "." & varEventDay(2)

        Set rngDateI = rngDatesI.Range("A:A").Find(m_datEventDay)

        varDates = rngDatesI.Range("A" & rngDateI.Row).Offset(-5).Resize(11)

           Do Until intTempII = intCounterDateV

                wksOut.Cells(intTempII + lngTempIV, 1) = m_strISIN

                wksOut.Cells(intTempII + lngTempIV, 4) = wksIn.Cells(intTempII + 1, intTempI + 1)

                wksOut.Cells(intTempII + lngTempIV, 3) = p_intRDLB + intTempIII

                wksOut.Cells(intTempII + lngTempIV, 2) = varDates(1 + intTempIII, 1)

                intTempII = intTempII + 1

                intTempIII = intTempIII + 1

            Loop

        lngTempIV = lngTempIV + intTempII - 1

        intTempII = 1

        intTempIII = 0

        intTempI = intTempI + 1

    Loop