buscar.vbs

Dim searchDict As Object
Dim lastSearchRangeAddress As String


Function buscarMontos(lookupValue As Variant, searchRange As Range, resultRange As Range, Optional numResultadosEsperados As Integer = 1) As Variant

    ' Definir variables
    Dim originalLookupValue As Variant
    Dim currentLookupValue As Variant
    Dim searchCell As Range
    Dim resultValue As Variant
    Dim resultArray() As Variant
    Dim colOffset As Integer
     
    Dim startTime As Double
    Dim endTime As Double
    Dim elapsedTime As Double
    
    ' Iniciar el temporizador
    startTime = Timer
    
    ' Inicializar variables
    originalLookupValue = lookupValue ' Guardar el valor original
    
    ' Ajustar tamaño del array de resultados
    ReDim resultArray(1 To numResultadosEsperados)
    
    ' Buscar todos los valores en el rango con diferentes prefijos
    For colOffset = 1 To numResultadosEsperados
        currentLookupValue = String(colOffset - 1, "9") & originalLookupValue
        
        ' Buscar el valor actual en el rango
        For Each searchCell In searchRange
            If searchCell.Value = currentLookupValue Then
                ' Encontrado, devolver el valor correspondiente de resultRange en el array
                resultValue = resultRange.Cells(searchCell.Row - searchRange.Row + 1, 1).Value
                resultArray(colOffset) = resultValue
                ' Salir del bucle si se ha encontrado el resultado
                Exit For
            End If
        Next searchCell
        
    Next colOffset

    ' Detener el temporizador
    endTime = Timer
    
    ' Calcular el tiempo transcurrido
    elapsedTime = endTime - startTime
    
    ' Mostrar el tiempo transcurrido en un mensaje
    ' MsgBox "Tiempo de ejecución: " & Format(elapsedTime, "0.00") & " segundos", vbInformation

    ' Devolver el array de resultados
    buscarMontos = resultArray ' Application.Transpose(resultArray)
    
End Function
    
Function buscarMontos2(lookupValue As Variant, searchRange As Range, resultRange As Range, Optional numResultadosEsperados As Integer = 1) As Variant

    ' Definir variables
    Dim originalLookupValue As Variant
    Dim currentLookupValue As Variant
    Dim searchArray As Variant
    Dim resultArray As Variant
    Dim resultLookupArray As Variant
    Dim i As Long, j As Long
    Dim found As Boolean
    
    Dim startTime As Double
    Dim endTime As Double
    Dim elapsedTime As Double
    
    ' Iniciar el temporizador
    startTime = Timer
    
    ' Inicializar variables
    originalLookupValue = lookupValue ' Guardar el valor original
    
    ' Leer los rangos en matrices para un acceso más rápido
    searchArray = searchRange.Value
    resultArray = resultRange.Value
    
    ' Ajustar tamaño del array de resultados
    ReDim resultLookupArray(1 To numResultadosEsperados)
    
    ' Buscar todos los valores en el rango con diferentes prefijos
    For i = 1 To numResultadosEsperados
        currentLookupValue = String(i - 1, "9") & originalLookupValue
        found = False
        
        ' Buscar el valor actual en la matriz de búsqueda
        For j = 1 To UBound(searchArray, 1)
            If searchArray(j, 1) = currentLookupValue Then
                ' Encontrado, devolver el valor correspondiente de resultArray en el array de resultados
                resultLookupArray(i) = resultArray(j, 1)
                found = True
                Exit For
            End If
        Next j
        
        ' Si no se encontró el valor, dejar vacío o asignar un mensaje
        If Not found Then
            resultLookupArray(i) = ""
        End If
        
    Next i
    
    ' Detener el temporizador
    endTime = Timer
    
    ' Calcular el tiempo transcurrido
    elapsedTime = endTime - startTime
    
    ' Mostrar el tiempo transcurrido en un mensaje
    ' MsgBox "Tiempo de ejecución: " & Format(elapsedTime, "0.00") & " segundos", vbInformation
    

    ' Devolver el array de resultados
    buscarMontos2 = resultLookupArray
    
End Function



Function buscarMontos3(lookupValue As Variant, searchRange As Range, resultRange As Range, Optional numResultadosEsperados As Integer = 1) As Variant

    ' Definir variables
    Dim originalLookupValue As Variant
    Dim currentLookupValue As Variant
    Dim resultArray() As Variant
    Dim i As Long
    Dim rowOffset As Long
    Dim startTime As Double
    Dim endTime As Double
    Dim elapsedTime As Double
    Dim currentSearchRangeAddress As String
    
    ' Inicializar variables
    originalLookupValue = lookupValue ' Guardar el valor original
    currentSearchRangeAddress = searchRange.Address
    
    ' Iniciar el temporizador
    startTime = Timer
    
    ' Verificar si el diccionario necesita ser actualizado
    If searchDict Is Nothing Or currentSearchRangeAddress <> lastSearchRangeAddress Then
        ' Crear o actualizar el diccionario
        Set searchDict = CreateDictionary(searchRange)
        
        ' Guardar la dirección del rango de búsqueda
        lastSearchRangeAddress = currentSearchRangeAddress
    End If
    
    ' Ajustar tamaño del array de resultados
    ReDim resultArray(1 To numResultadosEsperados)
    
    ' Buscar todos los valores en el rango con diferentes prefijos
    For i = 1 To numResultadosEsperados
        currentLookupValue = String(i - 1, "9") & originalLookupValue
        
        ' Buscar el valor actual en el diccionario
        If searchDict.exists(currentLookupValue) Then
            ' Encontrado, devolver el valor correspondiente de resultRange
            rowOffset = searchDict(currentLookupValue)
            resultArray(i) = resultRange.Cells(rowOffset, 1).Value
        Else
            ' No encontrado, dejar vacío o asignar un mensaje
            resultArray(i) = ""
        End If
        
    Next i
    
    ' Detener el temporizador
    endTime = Timer
    elapsedTime = endTime - startTime
    
    ' Mostrar el tiempo transcurrido en un mensaje
    ' MsgBox "Tiempo de ejecución: " & Format(elapsedTime, "0.00") & " segundos", vbInformation
    
    ' Devolver el array de resultados
    buscarMontos3 = resultArray
    
End Function


' Función privada para crear el diccionario
Private Function CreateDictionary(searchRange As Range) As Object
    Dim dict As Object
    Dim searchArray As Variant
    Dim i As Long
    
    ' Crear un nuevo diccionario
    Set dict = CreateObject("Scripting.Dictionary")
    
    ' Leer el rango de búsqueda en una matriz
    searchArray = searchRange.Value
    
    ' Construir el diccionario con los valores del rango de búsqueda
    For i = 1 To UBound(searchArray, 1)
        If Not dict.exists(searchArray(i, 1)) Then
            dict.Add searchArray(i, 1), i
        End If
    Next i
    
    ' Devolver el diccionario creado
    Set CreateDictionary = dict
End Function