Skip to content

Instantly share code, notes, and snippets.

@faller222

faller222/buscar.vbs

Created August 31, 2024 16:05
Show Gist options
  • Save faller222/f291fe0859bab7d9f5f677d29dbcd0c6 to your computer and use it in GitHub Desktop.
Save faller222/f291fe0859bab7d9f5f677d29dbcd0c6 to your computer and use it in GitHub Desktop.
Download ZIP
Raw
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
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment