How to get the content of this website to Excel with VBA and selectors?

I can assure you there's probably a better answer than this, but the following code works:

Sub getStuff()

' Declare variables
Dim XMLPage As New MSXML2.XMLHTTP60
Dim HTMLDoc As New MSHTML.HTMLDocument
Dim Table, Row, Data, Point As Variant
Dim i, x, j As Integer

' Make Request
With XMLPage
    .Open "GET", "https://www.zvg.com/appl/aufgehoben.prg?act=getHTML", False
    .send
    HTMLDoc.body.innerHTML = .responseText
End With

' Set counters
i = 1
x = 0
j = 1

' Parse data into worksheet
For Each Table In HTMLDoc.getElementsByTagName("tr")
    For Each Row In Table.getElementsByTagName("tr")
        For Each Data In Row.getElementsByTagName("td")
            ' Parse headers in first run
            If i = 1 Then
                Cells(i, j).Value = Data.innerText
            Else
                x = i
                ' Split the data points
                For Each Point In Split(Data.innerText, Chr(13))
                    Cells(i, j).Value = Point
                    i = i + 1
                Next Point
                If j <> 3 Then
                    i = x
                End If
            End If
            j = j + 1
        Next Data
    i = i + 1
    j = 1
    Next Row
Next Table

' Remove empty rows
Columns("C:C").Select
Selection.SpecialCells(xlCellTypeBlanks).Select
Selection.EntireRow.Delete

End Sub

Work with arrays, touch the sheet only at the end to reduce I/O, convert to using css selectors and doing your filtering within those selectors, use typed functions and reduce the code complexity.

Results:

Difference over 10,000 runs (single request, multiple parses and placing data in sheet).

Median difference was 5.4 times faster to make those changes over 10,000 runs.

No other difference in optimizations than described above. ScreenUpdating was switched off for both.

VBA:

Option Explicit

Public r As Long

Public Sub GetContents()
    
    Dim http As MSXML2.XMLHTTP60, html As MSHTML.HTMLDocument
    
    Set http = New MSXML2.XMLHTTP60: Set html = New MSHTML.HTMLDocument
    
    With http
        .Open "GET", "https://www.zvg.com/appl/aufgehoben.prg?act=getHTML", False
        .send
        html.body.innerHTML = .responseText
    End With
    
    Dim colOne As MSHTML.IHTMLDOMChildrenCollection, colTwoAndThree As MSHTML.IHTMLDOMChildrenCollection, i As Long
    
    Set colOne = html.querySelectorAll("td + td > table td + td:nth-child(2)")
    Set colTwoAndThree = html.querySelectorAll("td + td > table td + td:nth-child(3)")
    
    Dim headers() As Variant, results() As Variant
    
    headers = Array("ID-Number", "Date", "Time")
    ReDim results(1 To 1000, 1 To UBound(headers) + 1)
    
    With colOne
        
        For i = 0 To colOne.Length - 1
    
            UpdateResults results, colOne.Item(i).innerText, colTwoAndThree.Item(i).innerText

        Next
        
    End With

    results = Application.Transpose(results)
    ReDim Preserve results(1 To UBound(headers) + 1, 1 To r)
    results = Application.Transpose(results)
    
    With ActiveSheet
        .Cells(1, 1).Resize(1, UBound(headers) + 1) = headers
        .Cells(2, 1).Resize(UBound(results, 1), UBound(results, 2)) = results
    End With
End Sub

Public Sub UpdateResults(ByRef results As Variant, ByVal col1 As String, ByVal col2And3 As String)
    Dim arrCol1() As String, arrCol2And3() As String
    Dim i As Long, datetime() As String
    
    arrCol1 = Split(col1, Chr$(10))
    arrCol2And3 = Split(col2And3, vbCrLf)
    
    For i = LBound(arrCol1) To UBound(arrCol1)
        r = r + 1
        results(r, 1) = Trim$(arrCol1(i))
        datetime = Split(arrCol2And3(i), Chr$(32))
        results(r, 2) = datetime(0): results(r, 3) = datetime(1)
    Next
End Sub

Passing r as param in signature (rather than Public):

Option Explicit

Public Sub GetContents()
    
    Dim http As MSXML2.XMLHTTP60, html As MSHTML.HTMLDocument
    
    Set http = New MSXML2.XMLHTTP60: Set html = New MSHTML.HTMLDocument
    
    With http
        .Open "GET", "https://www.zvg.com/appl/aufgehoben.prg?act=getHTML", False
        .send
        html.body.innerHTML = .responseText
    End With
    
    Dim colOne As MSHTML.IHTMLDOMChildrenCollection, colTwoAndThree As MSHTML.IHTMLDOMChildrenCollection, i As Long
    
    'Set colOne = html.querySelectorAll("td + td > table td + td:nth-child(2)")
    Set colOne = html.querySelectorAll("td td + td[style*='150']")
    'Set colTwoAndThree = html.querySelectorAll("td + td > table td + td:nth-child(3)")
    Set colTwoAndThree = html.querySelectorAll("td td + td[style*='150'] + td")
    
    Dim headers() As Variant, results() As Variant
    
    headers = Array("ID-Number", "Date", "Time")
    ReDim results(1 To 1000, 1 To UBound(headers) + 1)
    
    With colOne
        
        For i = 0 To colOne.Length - 1
    
            UpdateResults results, colOne.Item(i).innerText, colTwoAndThree.Item(i).innerText, r

        Next
        
    End With

    results = Application.Transpose(results)
    ReDim Preserve results(1 To UBound(headers) + 1, 1 To r)
    results = Application.Transpose(results)
    
    With ActiveSheet
        .Cells(1, 1).Resize(1, UBound(headers) + 1) = headers
        .Cells(2, 1).Resize(UBound(results, 1), UBound(results, 2)) = results
    End With
End Sub

Public Sub UpdateResults(ByRef results As Variant, ByVal col1 As String, ByVal col2And3 As String, ByRef r As Long)
    Dim arrCol1() As String, arrCol2And3() As String
    Dim i As Long, datetime() As String
    
    arrCol1 = Split(col1, Chr$(10))
    arrCol2And3 = Split(col2And3, vbCrLf)
    
    For i = LBound(arrCol1) To UBound(arrCol1)
        r = r + 1
        results(r, 1) = Trim$(arrCol1(i))
        datetime = Split(arrCol2And3(i), Chr$(32))
        results(r, 2) = datetime(0): results(r, 3) = datetime(1)
    Next
End Sub