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,

bei mir kommt der Fehler nicht.

Aber du hast am Ende 3 Workbooks offen. Da musst du exakt referenzieren, sonst nimmt der Code immer das aktuelle Workbook und Worksheet.

Ändere mal die Zeile auf:

Set wksThis = wbkOpen.Worksheets(1)

Claus

Answer 5

Hi Claus,

danke für deine Mühe. Ich bekomme leider einen Fehler in der Sub "RenameInput" mit dem Vermerk. Es könne nicht der ganze Bereich geändert werden. Den Fehler habe ich bei mir schon ein paar Mal sporadisch gesehen, die Ursache konnte ich noch nicht feststellen.

Deine Änderungen habe ich mir schon angeschaut, aber verstehe noch nicht alles. Bin ja noch sehr frisch drin.

Ich werde in den nächsten Wochen wohl erst wieder die Zeit finden, mich konkret mit dem Code auseinanderzusetzen. Ich sage dir dann auf jeden Fall Bescheid, ob es a) schneller ist und b) ich alles verstanden habe :-D

Vielen Dank für deine Ideen! Bis demnächst

Florian