Si tengo un listado de contratos repetidos en una columna, pero solo quiero el resumen de los mismos:
CONTRACT 4 |
| CONTRACT 1 |
| CONTRACT 2 |
| CONTRACT 1 |
| CONTRACT 3 |
| CONTRACT 1 |
| CONTRACT 3 |
| CONTRACT 1 |
| CONTRACT 5 |
| CONTRACT 1 |
| CONTRACT 1 |
| CONTRACT 4 |
| CONTRACT 1 |
| CONTRACT 5 |
| CONTRACT 5 |
| CONTRACT 3 |
| CONTRACT 3 |
|
|
Asigno cada celda a un array, solo agrego elementos al array si no constan ya dentro del mismo:
Sub create()
'Declaro un array en blanco y un contador para ir llenandolo.
Dim contracts() As String
Dim n As Integer
n = 0
'Por cada celda del rango
For Each cell In Range("a1", "a" & Range("a1").End(xlDown).Row)
'Si la longitud del array es 0, entonces agrego la celda.
If Len(Join(contracts)) < 1 Then
ReDim Preserve contracts(n)
contracts(n) = cell.Value
n = n + 1
'Llena y pasa a la siguiente celda del rango:
GoTo cont:
Else
'Testea si el valor de la celda ya ha existe dentro del array, la funcion la copié de un foro.
'Si el valor no existe, agrega la celda al array.
If Not IsInArray(cell.Value, contracts) Then
ReDim Preserve contracts(n)
contracts(n) = cell.Value
n = n + 1
End If
End If
cont:
Next cell
'Ahora a poblar otra columna con los contratos encontrados.
upper = n 'es la fila maxima a pegar, que equivale al contador de los arrays ingresados
n = 0 'reinicio el contador para ir obteniedo los valores del array y pegarlos
'Pego los valores
For brow = 1 To upper
Range("B" & brow).Value = contracts(n)
n = n + 1
Next brow
End Sub
---------esta es la funcion que usé para testear si un valor se encontraba dentro de un array---------
Function IsInArray(stringToBeFound As String, arr As Variant) As Boolean
IsInArray = (UBound(Filter(arr, stringToBeFound)) > -1)
End Function
Nota: Estoy creando un tutorial para aprender a utilizar VBA en la oficina. La pagina es
www.macroreportes.com eventualmente ire agregando mas secciones, por lo que si quieres seguir el curso seria buena idea registrar tu email en la pagina para recibir las notificaciones cuando suba un nuevo post.
