-
Notifications
You must be signed in to change notification settings - Fork 0
/
Copy pathbas_lib_search_0001.bas
135 lines (133 loc) · 5.54 KB
/
bas_lib_search_0001.bas
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
' -----------------------------------------------------------------------
' vbaMyLib Version: 0.1.2 Release Date: 20170123
' © Copyright 2001-2023 Manu Herrán
' Free download source code:
' http://manuherran.com/
' -----------------------------------------------------------------------
Option Explicit
' -----------------------------------------------------------------------
' Tested with Access 2003
' -----------------------------------------------------------------------
' Funciones
' -----------------------------------------------------------------------
' search_0001_searchArrayItem
'
'
' -----------------------------------------------------------------------
Global Const CTE_MENOS_UNO_NO_ENCONTRADO = -1
Global Const CTE_BUSQUEDA_SECUENCIAL = 10
Global Const CTE_BUSQUEDA_BINARIA = 20
Function search_0001_searchArrayItem(elemento As Variant, myArray() As Variant, Lb As Long, Ub As Long, Optional matchCase, Optional searchAlgorithm) As Long
'-------------------------------------------------
'Tratamiento de parámetros opcionales. Por defecto:
'matchCase = CTE_MATCH_CASE
'searchAlgorithm = CTE_BUSQUEDA_SECUENCIAL
If IsMissing(matchCase) Then matchCase = CTE_MATCH_CASE
If IsMissing(searchAlgorithm) Then searchAlgorithm = CTE_BUSQUEDA_SECUENCIAL
'-------------------------------------------------
'Devuelve la posición
'Ejemplo de llamada
'casilla_a_borrar = searchArrayItem_s("Azul", miarr(), 1, 30)
'-------------------------------------------------
Dim i As Long
Select Case matchCase
Case CTE_MATCH_CASE
Select Case searchAlgorithm
Case CTE_BUSQUEDA_SECUENCIAL
'Búsqueda secuencial
i = Lb
While i <= Ub
If Trim(myArray(i)) = Trim(elemento) Then
searchArrayItem_s = i
Exit Function
End If
i = i + 1
Wend
If i > Ub Then
searchArrayItem_s = CTE_MENOS_UNO_NO_ENCONTRADO
Else
error_0001_fFatalError "Error en searchArrayItem_s"
End If
Case CTE_BUSQUEDA_BINARIA
i = Lb + Int((Ub - Lb) / 2)
If Trim(myArray(i)) = Trim(elemento) Then
searchArrayItem_s = i
Else
If Lb = Ub Then
searchArrayItem_s = CTE_MENOS_UNO_NO_ENCONTRADO
Else
If Lb + 1 = Ub Then
If Trim(myArray(Lb)) = Trim(elemento) Then
searchArrayItem_s = Lb
Else
If Trim(myArray(Ub)) = Trim(elemento) Then
searchArrayItem_s = Ub
Else
searchArrayItem_s = CTE_MENOS_UNO_NO_ENCONTRADO
End If
End If
Else
If Trim(myArray(i)) > Trim(elemento) Then
searchArrayItem_s = searchArrayItem_s(elemento, myArray(), Lb, i - 1, matchCase, searchAlgorithm)
Else
searchArrayItem_s = searchArrayItem_s(elemento, myArray(), i + 1, Ub, matchCase, searchAlgorithm)
End If
End If
End If
End If
Case Else
error_0001_fFatalError "Tipo de búsqueda no existente"
End Select
'===========================================================================
Case CTE_NO_MATCH_CASE
'===========================================================================
Select Case searchAlgorithm
Case CTE_BUSQUEDA_SECUENCIAL
'Búsqueda secuencial
i = Lb
While i <= Ub
If UCase(Trim(myArray(i))) = UCase(Trim(elemento)) Then
searchArrayItem_s = i
Exit Function
End If
i = i + 1
Wend
If i > Ub Then
searchArrayItem_s = CTE_MENOS_UNO_NO_ENCONTRADO
Else
error_0001_fFatalError "Error en searchArrayItem_s"
End If
Case CTE_BUSQUEDA_BINARIA
i = Lb + Int((Ub - Lb) / 2)
If UCase(Trim(myArray(i))) = UCase(Trim(elemento)) Then
searchArrayItem_s = i
Else
If Lb = Ub Then
searchArrayItem_s = CTE_MENOS_UNO_NO_ENCONTRADO
Else
If Lb + 1 = Ub Then
If UCase(Trim(myArray(Lb))) = UCase(Trim(elemento)) Then
searchArrayItem_s = Lb
Else
If UCase(Trim(myArray(Ub))) = UCase(Trim(elemento)) Then
searchArrayItem_s = Ub
Else
searchArrayItem_s = CTE_MENOS_UNO_NO_ENCONTRADO
End If
End If
Else
If UCase(Trim(myArray(i))) > UCase(Trim(elemento)) Then
searchArrayItem_s = searchArrayItem_s(elemento, myArray(), Lb, i - 1, matchCase, searchAlgorithm)
Else
searchArrayItem_s = searchArrayItem_s(elemento, myArray(), i + 1, Ub, matchCase, searchAlgorithm)
End If
End If
End If
End If
Case Else
error_0001_fFatalError "Tipo de búsqueda no existente"
End Select
Case Else
error_0001_fFatalError "Tipo de case no existente"
End Select
End Function