Holas, quiero exponer o intentare hacer algo así como un tuto para manejar array de una forma muy rápida, para mi es algo nuevo ya que nunca me salio. la idea es utilizando el api CopyMemory es muchisimo mas rápido de lo que se puede llamar método tradicional.
vamos por parte
utilizaremos un array de tipo Long
Option Explicit
Private Declare Sub CopyMemory Lib "kernel32.dll" Alias "RtlMoveMemory" (ByRef Destination As Any, ByRef Source As Any, ByVal Length As Long)
Private Declare Function GetTickCount Lib "kernel32.dll" () As Long
Dim Arr() As Long
Private Sub Form_Load()
Dim i As Long
ReDim Arr(1000000)
For i = 0 To 1000000
Arr(i) = i
Next
End Sub
nuestro array se llamara
Arr()ahora vamos a intentar eliminar un items de esos 1000001 que posee
el metodo clasico seria
Private Function RemoveClasic(index As Long)
Dim i As Long
Dim Temp As Long
For i = index To UBound(Arr) - 1
Temp = Arr(i + 1)
Arr(i) = Temp
Next
ReDim Preserve Arr(UBound(Arr) - 1)
End Function
Osea ir meditante un bucle ir cargando el item siguiente al actual, esto es lentisimo si tenemos muchos items.
ahora utilizando CopyMemory
Private Function Remove(index As Long)
Dim LenArray As Long
Dim tArray() As Long
LenArray = UBound(Arr)
ReDim tArray(LenArray - 1)
If index > 0 Then CopyMemory tArray(0), Arr(0), 4 * index
CopyMemory tArray(index), Arr(index + 1), 4 * (LenArray - index)
ReDim Arr(LenArray - 1)
CopyMemory Arr(0), tArray(0), 4 * LenArray
End Function
el numero 4 que aparece en el codigo es porque trabajamos con una array de tipo Long si fuera byte utilizariamos un 2, si fuera un type LenB(elTipo) o bien contamos a dedos
Realmente no probre esto con Strings no estoy seguro que funcione, si alguien lo prueba o sabe, que cuente si da resultado.
lo que hace es ir copiando segmentos enteros del array a uno temporal, la primera parte es la anterior del item a eliminar y luego la posterior, y por final copiar el temporal al array original.
Insertar un item (por la mitad del array por ejemplo, no al final)
Private Function Insert(index As Long, Value As Long)
Dim LenArray As Long
Dim tArray() As Long
LenArray = UBound(Arr) + 1
ReDim tArray(LenArray)
If index > 0 Then CopyMemory tArray(0), Arr(0), 4 * index
tArray(index) = Value
CopyMemory tArray(index + 1), Arr(index), 4 * (LenArray - index)
ReDim Arr(LenArray)
CopyMemory Arr(0), tArray(0), 4 * (LenArray + 1)
End Function
comprobar si un item existe
Private Function ItemExist(key As Long) As Boolean
Dim i As Long
For i = 0 To UBound(Arr)
If Arr(i) = key Then: ItemExist = True: Exit For
Next
End Function
esto es de la forma tradicional, no encontre una forma mas rapida. pero quiero alcarar los siguiente:
si declaramos
i dentro de la funcion es mas rapido que si lo declaramos en el general.
si usamos
if then en una sola linea es mas rapido.
el codigo completo
Option Explicit
Private Declare Sub CopyMemory Lib "kernel32.dll" Alias "RtlMoveMemory" (ByRef Destination As Any, ByRef Source As Any, ByVal Length As Long)
Private Declare Function GetTickCount Lib "kernel32.dll" () As Long
Dim Arr() As Long
Private Sub Form_Load()
Dim i As Long
ReDim Arr(1000000)
For i = 0 To 1000000
Arr(i) = i
Next
End Sub
Private Sub Command1_Click()
Dim StartTime As Long
Dim i As Long
StartTime = GetTickCount
For i = 0 To 100
ItemExist 1000000 '<1000000 el peor de los casos
Next
Debug.Print GetTickCount - StartTime
End Sub
Private Sub Command2_Click()
'Dim StartTime As Long
Dim i As Long
'StartTime = GetTickCount
'For i = 0 To 100
Remove 0
'Next
For i = 0 To 10
Debug.Print Arr(i)
Next
'Debug.Print GetTickCount - StartTime
End Sub
Private Sub Command3_Click()
Dim i As Long
Insert 5, 666666
For i = 0 To 10
Debug.Print Arr(i)
Next
End Sub
Private Function ItemExist(key As Long) As Boolean
Dim i As Long
For i = 0 To UBound(Arr)
If Arr(i) = key Then: ItemExist = True: Exit For
Next
End Function
Private Function Remove(Index As Long)
Dim LenArray As Long
Dim tArray() As Long
LenArray = UBound(Arr)
ReDim tArray(LenArray - 1)
If Index > 0 Then CopyMemory tArray(0), Arr(0), 4 * Index
CopyMemory tArray(Index), Arr(Index + 1), 4 * (LenArray - Index)
ReDim Arr(LenArray - 1)
CopyMemory Arr(0), tArray(0), 4 * LenArray
End Function
Private Function Insert(Index As Long, Value As Long)
Dim LenArray As Long
Dim tArray() As Long
LenArray = UBound(Arr) + 1
ReDim tArray(LenArray)
If Index > 0 Then CopyMemory tArray(0), Arr(0), 4 * Index
tArray(Index) = Value
CopyMemory tArray(Index + 1), Arr(Index), 4 * (LenArray - Index)
ReDim Arr(LenArray)
CopyMemory Arr(0), tArray(0), 4 * (LenArray + 1)
End Function
hice unas pruebas con Coleciones y son muchas mas lentas que usar array , lo unico es mas raipido a la hora de intentar accerder a un item atraves de las key
Despedida:
Este tuto es mas dificil de entender que intentar tipear una capcha en chino basico.
si dije muchas pabadas no peguen fuerte
