Sub X()
    Dim cnn As ADODB.Connection
    Dim rst As ADODB.Recordset
    Dim rng As Excel.Range
    Dim lngSumma As Long
    
    Set cnn = New ADODB.Connection
    Set rst = New ADODB.Recordset
    Set rng = [A1:A2]
    
    cnn.Open "Driver={Microsoft dBASE Driver (*.dbf)};DriverID=277;Dbq=C:\1;"
    rst.Open "SELECT * FROM Test.dbf ORDER BY REGN", cnn, , , adCmdText
    
    For Each rng In rng.Cells
        lngSumma =  0 
    
        Do Until rst.EOF
            If rng.Value = rst!REGN Then
                lngSumma = lngSumma + rst!VR
            End If
        rst.MoveNext
        Loop
        
        rng.Offset( 0 ,  1 ).Value = lngSumma
    Next rng
    
    rst.Close
    cnn.Close
    
    Set rst = Nothing
    Set cnn = Nothing
End Sub