VLookUp met tijd in VBA

[Woffels]

Ik heb twee tabbladen, hr_data_raw en hr_data_val

Ik probeer nu data(temperatuur) via VLookup van het eerste tabblad naar het tweede tabblad kopiëren op basis van datum en tijd. De data op het eerste tabblad (bron) is steeds anders, dat wordt namelijk met een query binnen gehaald. In dit geval staat er data vanaf 1 september in dat tabblad. De volgende maand oktober etc. Nu is het de bedoeling dat het tweede tabblad een jaaroverzicht gaat worden dat steeds gevuld moet worden met nieuwe data uit het eerste. Waarom ik dit doe is, omdat er in de bron af en toe een uur weg kan vallen of middels validatie leeg wordt gemaakt. Bij ontbrekende data in het eerste tabblad, moet op de plaats van dat ontbrekende uur in het tweede tabblad die cel leeg zijn.

Ik ben eens wat gaan stoeien met VLookup en heb het volgende:

Public Sub Example1()
    Dim Result As Variant
    Dim LookUpValue As Range
    Dim LookUpRange As Range
    Set LookUpRange = Sheets("hr_data_raw").Range("A2:AV21")
    ''Regel 1
    Set LookUpValue = Sheets("hr_data_val").Cells(2, 1)
    Sheets("hr_data_val").Range("B2") = Application.WorksheetFunction.VLookup(LookUpValue.Value2, LookUpRange, 2, False)
     ''Regel2
    Set LookUpValue = Sheets("hr_data_val").Cells(3, 1)
    Sheets("hr_data_val").Range("B3") = Application.WorksheetFunction.VLookup(LookUpValue.Value2, LookUpRange, 2, False)
End Sub

Om het te proberen herhaal ik de opdracht even twee keer, later maak ik daar wel een lus van. Als je de code runt, zie je dat "Regel1" precies doet wat ik wil, maar "Regel2" geeft een fout.
Wat gaat hier mis?

 

[edmoor]

Gebruik Range.Find in plaats van een WorksheetFunction:
https://docs.microsoft.com/en-us/office/vba/api/excel.range.find

 

[Woffels]

Bedankt, ik ga ermee aan de gang, toch ben ik erg benieuwd waarom het de eerste keer wel goed gaat en de tweede niet.

 

[edmoor]

Geen idee want zo gebruik ik dat nooit.
Kijk eens naar dit:

Public Sub Example1()
    With Sheets("hr_data_raw").Range("A2:A2000")
        For i = 2 To 2000
            Set c = .Find(Sheets("hr_data_val").Cells(i, 1), , , xlWhole)
            If Not c Is Nothing Then Sheets("hr_data_val").Cells(i, 2).Value = c.Offset(, 1)
        Next i
    End With
End Sub

 

[Woffels]

Die werkt goed, bedankt.
Toch ben ik zelf ook nog even door gegaan en gaan werken met 2 arrays en vergelijken, ook hier worden de eerste twee cellen gevuld en dan stopt het vullen terwijl als ik debug geen fouten zie. Iemand die er eens naar kan kijken, ik snap namelijk niet wat er fout gaat?

Public Sub HrRawToVal()
arrRaw = ThisWorkbook.Sheets(1).Cells(1).CurrentRegion
arrVal = ThisWorkbook.Sheets(2).Cells(1).CurrentRegion
LastRowVal = hr_data_val.Cells(Rows.Count, "A").End(xlUp).Row
LastRowRaw = hr_data_raw.Cells(Rows.Count, "A").End(xlUp).Row

For i = 2 To LastRowRaw
Searchfor = (arrRaw(i, 1))
    For j = 2 To LastRowVal
        DataVal = (arrVal(j, 1))
        If DataVal = Searchfor Then
            hr_data_val.Cells(j, 2) = arrRaw(i, 2)
            Exit For
        End If
    Next j
Next i
End Sub

 

[edmoor]

Haal die Exit For eens weg.

 

[Woffels]

Het is de bedoeling dat ie stopt met zoeken als ie een match heeft gevonden, vandaar die Exit For en werkt ook prima de eerste twee keer.
Als je code runt vult ie dus wel de eerste twee waardes op de juiste plaats, maar daarna werkt de vergelijking (if) niet meer terwijl de twee variabelen wel dezelfde inhoud hebben.

 

[edmoor]

Ik had dat inderdaad verkeerd gelezen.
Maar hier levert het toch een verschil op:

 

[Woffels]

Zet maar eens een breakpoint op de plek van mijn vorige plaatje en dan doorstappen, je ziet in de sheet de eerste twee waardes komen, daarna komt ie niet meer door die if, terwijl de voorwaardes wel kloppen.

 

[edmoor]

Dat is wat ik deed.
Wel vreemd inderdaad.

Bij nader inzien denk ik dat het komt door het beruchte afrondings probleem in Excel.
Doe die vergelijking eens zo:

If CStr(dataval) = CStr(searchfor) Then

 

[Woffels]

Pffffffff, dat is het het, heeft me een hoop tijd gekost, maar het is opgelost, bedankt.

Dit is het uiteindelijk geworden:

Public Sub HrRawToVal1()
arrRaw = ThisWorkbook.Sheets(3).Cells(1).CurrentRegion
arrVal = ThisWorkbook.Sheets(4).Cells(1).CurrentRegion
LastRowVal = hr_data_val.Cells(Rows.Count, "A").End(xlUp).Row
LastRowRaw = hr_data_raw.Cells(Rows.Count, "A").End(xlUp).Row

For i = 2 To LastRowRaw
Searchfor = (arrRaw(i, 1))
    For j = 2 To LastRowVal
        DataVal = (arrVal(j, 1))
        If CStr(DataVal) = CStr(Searchfor) Then
            hr_data_val.Cells(j, 2) = arrRaw(i, 2)
            Exit For
        End If
    Next j
Next i
End Sub

 

[edmoor]

Dat kan ook wel wat korter:

Public Sub HrRawToVal1()
    arrRaw = Sheets("hr_data_raw").Cells(1).CurrentRegion
    arrVal = Sheets("hr_data_val").Cells(1).CurrentRegion
    
    For i = 2 To UBound(arrRaw)
        For j = 2 To UBound(arrVal)
            If CStr(arrVal(j, 1)) = CStr(arrRaw(i, 1)) Then
                hr_data_val.Cells(j, 2) = arrRaw(i, 2)
                Exit For
            End If
        Next j
    Next i
End Sub

 

[Woffels]

Klopt, maar er komen ook nog wel meer kolommen bij, het ging me nu nog even om die vastloper.

 

[snb]

Gebruik de volgende matrix-formule:

=IFERROR(INDEX(TableHr[Temp];MATCH(TEXT([@[Datum/tijd]];"0,000");TEXT(TableHr[Datum/tijd];"0,000");0));"")