OBTENER EL VALOR MÁXIMO Y MÍNIMO EN UNA MATRIZ

Hola a todos!

En el post de hoy voy a tratar un aspecto importante a la hora de trabajar con matrices, esto es, obtener el valor máximo o mínimo en un array (matriz).

No siempre trabajaremos con rangos, donde la obtención del valor máximo o mínimo es sencilla (utilizando las funciones MAX o MIN), muchas veces tenemos que utilizar matrices en nuestros procesos y en ocasiones debemos extraer ciertos valores.

Existen varias formas de hacer este trabajo, aunque hoy os mostraré la que yo suelo utilizar. Dependiendo de si la matriz nos viene creada o la debemos crear nosotros, el proceso será más o menos extenso.

Voy a suponer que tenemos los datos en una hoja Excel y debemos pasarlos a una matriz para luego determinar el valor mínimo y máximo de ese rango:

OBTENER EL VALOR MAXIMO Y MINIMO EN UNA MATRIZ

Ejecutando el siguiente código vamos a poder obtener los datos que necesitamos:

Sub OBTENER_MAX_MIN()
Dim rng As Range, fin As Long, celda As Variant
Dim sCadena As String, listMatriz As Object, nDato As Variant, nCadena As String
Dim oMatriz As Variant, n As Long, Min As Double, Max As Double
'Seleccionamos rango de números
Set rng = Selection
fin = rng.Count
'Controlamos que seleccionamos un rango de celdas con datos
If fin <= 1 Then Exit Sub
'Componemos una string con los valores seleccionados
For Each celda In rng
sCadena = Trim(sCadena) & " " & celda.Value
Next celda
'Pasamos los datos a una matriz (Lista)
Set listMatriz = CreateObject("System.Collections.ArrayList")
For Each nDato In Split(sCadena, " ")
listMatriz.Add nDato
Next nDato
'Ordenamos los datos
listMatriz.Sort
'Pasamos los datos a una cadena de texto
For Each nDato In listMatriz
nCadena = Trim(nCadena) & " " & nDato
Next nDato
'Convertimos el string en una matriz y con un loop extraemos valor mínimo y máximo
oMatriz = Split([nCadena], " ")
For n = LBound(oMatriz) To UBound(oMatriz)
If n = LBound(oMatriz) Then Min = oMatriz(n)
If n = UBound(oMatriz) Then Max = oMatriz(n)
Next
'Mostramos resultado en msgbox
MsgBox ("El valor mínimo es: " & Min & " y el valor máximo es: " & Max)
'Liberamos espacio en memoria
Set listMatriz = Nothing
End Sub

Lo verdaderamente importante de la macro es el método utilizado para obtener el valor máximo y mínimo. Es decir, componemos un array:

'Pasamos los datos a una matriz (Lista)
Set listMatriz = CreateObject("System.Collections.ArrayList")
For Each nDato In Split(sCadena, " ")
listMatriz.Add nDato

Next nDato

y ordenamos los datos:

listMatriz.Sort

A continuación volvemos a pasar la información a una cadena de texto con los datos ordenados:

'Pasamos los datos a una cadena de texto
For Each nDato In listMatriz
nCadena = Trim(nCadena) & " " & nDato
Next nDato

En este punto, la información que tenemos es una cadena de texto totalmente ordenada, aquí lo podéis ver mostrando el contenido de la variable nCadena:

OBTENER EL VALOR MAXIMO Y MINIMO EN UNA MATRIZ1

Con esta información, ahora ya podemos obtener los datos que estamos buscando. Dado que sabemos que el primer valor de la cadena es el mínimo y el último el máximo, solo tenemos extraer esa información.

Esto lo podemos hacer de varias formas, pero dado que estamos trabajando con matrices, esta es la solución que voy a utilizar. Pasamos los datos de nuevo a una matriz y mediante un bucle “for-next” y con las funciones LBound y UBound que determinan el inicio de la matriz (siempre es 0) y el final, (en este caso 60, dado que son 60 elementos seleccionados), podemos detectar con un condicional cuando “n” es igual a LBound o “0” y obtendremos el mínimo, y de la misma forma, cuando “n” es igual a UBound obtendremos el máximo valor:

oMatriz = Split([nCadena], " ")
For n = LBound(oMatriz) To UBound(oMatriz)
If n = LBound(oMatriz) Then Min = oMatriz(n)
If n = UBound(oMatriz) Then Max = oMatriz(n)
Next

Como habéis podido observar, ya hemos conseguido la información que necesitábamos. Ahora podemos incluir esta información en nuestros procesos o cálculos dado que está contenida en ambas variables (Min y Max).

Para que veáis el resultado de la macro, he pasado los resultados a un msgbox para ver de manera informativa los datos:

OBTENER EL VALOR MAXIMO Y MINIMO EN UNA MATRIZ2

Aunque debería haber utilizado directamente un matriz, sin hacer referencia a la hoja ni al rango seleccionado, creo que de esta forma se ilustra mejor el ejemplo.

Y esto es todo, espero que esta metodología os ayude en vuestros procesos.

Descarga el archivo de ejemplo pulsando en: OBTENER EL VALOR MÁXIMO Y MÍNIMO EN UNA MATRIZ

¿Te ha resultado de interés?, puedes apoyar a Excel Signum con una pequeña donación.

Donate Button with Credit Cards

¡¡Muchas gracias!!

Anuncios

SUMAR EL VALOR DE CADA N NÚMEROS EN UN RANGO

Hola a todos!

Hoy de nuevo voy a escribir sobre funciones matriciales, en el post de hoy veremos cómo podemos sumar el valor de cada “n” números en un rango.

Creo que la mejor forma de explicar esto se puede hacer con una imagen:

SUMAR CADA N VALOR EN UN RANGO

Imaginad que tenemos que hallar el resultado de cada cuatro números en la columna A, (adicionalmente en la columna B he colocado estos números para ofrecer un ejemplo más claro. El resultado sería de 40.

Para realizar esta operación con una sola fórmula o bien recurrimos a macros o bien utilizamos fórmulas matriciales. En el ejemplo de hoy utilizaré una fórmula matricial:

{=SUMA(SI(RESIDUO(FILA(INDIRECTO("1:"&CONTAR(A:A)));4)=0;DESREF(A2;0;0;COINCIDIR(9,99999999999999E+307;A:A)-FILA(A2)+1;1);""))}

Una vez aplicada, el resultado es el de 40:

SUMAR CADA N VALOR EN UN RANGO1

Con esta fórmula somos capaces de obtener los “n” valores que decidamos dentro de un rango variable y proceder a su suma. En rojo está el número que os servirá para indicar el “n” valor, en este ejemplo, el 4.

Os recuerdo que las matrices se introducen: seleccionando la celda que contiene la fórmula, pulsando en F2 , seleccionamos la fórmula y luego presionamos CTRL + MAYUS + ENTRAR

Y esto a ha sido todo, espero que os resulte de interés.

Descarga el archivo de ejemplo pulsando en: SUMAR EL VALOR DE CADA N NÚMEROS EN UN RANGO

¿Te ha resultado de interés?, puedes apoyar a Excel Signum con una pequeña donación.

Donate Button with Credit Cards

¡¡Muchas gracias!!

GENERAR FACTURAS USANDO VBA, CREAR UN PROGRAMA DE FACTURACIÓN

Hola a todos!!

En el post de hoy vamos a confeccionar un pequeño programa que nos ayudará a generar facturas.

Lo haremos mediante programación, la razón es que el uso de fórmulas y VBA al mismo tiempo pueden ralentizar nuestros procesos y hacerlo todo con código hará más eficiente nuestro proyecto.

Cuando hablamos de generar facturas, siempre tenemos que pensar en la fuente y la estructura de los datos a partir de la cual confeccionaremos nuestras facturas. Para este ejemplo y para esta programación partiré de una estructura de datos específica, en cuanto a la fuente de datos (el programa que nos devuelve esa información), vamos a suponer que es un archivo Excel, de Access, TXT o el report de un programa específico (que puede estar diseñado en Excel, Access, etc).

El concepto que debemos tener claro es que en esta base de datos inicial, cada factura se va a repetir tantas veces como elementos tenga. Es decir, si en una factura tenemos 6 productos, esa factura (y todos sus datos) se repetirán 6 veces.

Os muestro una imagen de esa base de datos y sus conceptos, vamos a suponer que somos una empresa distribuidora de material eléctrico:

GENERAR FACTURAS USANDO VBA

Como podéis observar, existen multitud de campos y todos ellos los vamos a necesitar para poder generar facturas a partir de esta plantilla base:

GENERAR FACTURAS USANDO VBA1

Pues bien, he creado tres botones a la derecha (fuera del área de impresión) que serán los comandos que vamos a utilizar para crear la factura. Además en la propia factura existen dos ComboBox dependientes para poder seleccionar las facturas por cliente, es decir cuando seleccionemos un cliente, el combo que muestra los números de factura solo nos mostrará las facturas relacionadas a ese cliente.

Dado siempre vamos a interactuar con esos botones de comando, os iré comentando su función y la macro que tienen asociada. Empezamos por el botón ACTUALIZAR INFORMACIÓN:

Con este botón vamos a cargar o actualizar el nombre de las empresas y el número de factura de los ComboBox 1 y 2. La macro asociada es la siguiente:

Sub ACTUALIZAR_EMPRESAS()
'Definimos las variables
Dim Dataread As Object, obSQL As String
Dim cnn As Object, MiLibro As String
'Vaciamos combobox1
With Sheets("FACTURA")
.ComboBox1.Clear
'Iniciamos consulta para cargar registros únicos de Nombre de la empresa
obSQL = "SELECT distinct [DATOS_FACTURA$].[NOMBRE] " & _
"FROM [DATOS_FACTURA$] " & _
"Where [DATOS_FACTURA$].[NOMBRE]"
'Guardamos el nombre del libro activo para utilizarlo en la conexión ADO
MiLibro = ActiveWorkbook.Name
'Iniciamos la conexión ADO
Set cnn = CreateObject("ADODB.Connection")
With cnn
.Provider = "Microsoft.ACE.OLEDB.12.0"
.ConnectionString = "DATA SOURCE=" & Application.ActiveWorkbook.Path + "\" & MiLibro
.Properties("Extended Properties") = "Excel 12.0"
.Open
End With
'Procedemos a grabar los datos de la consulta
Set Dataread = CreateObject("ADODB.Recordset")
With Dataread
.Source = obSQL
.ActiveConnection = cnn
.CursorType = adOpenForwardOnly
.Open
End With
Do Until Dataread.EOF
'Pasamos la información al Combobox1
.ComboBox1.AddItem Dataread("NOMBRE")
Dataread.MoveNext
Loop
MsgBox ("SE HA ACTUALIZADO LA INFORMACIÓN"), vbInformation
'Liberamos y cerramos variables
Dataread.Close: Set Dataread = Nothing
cnn.Close: Set cnn = Nothing
End With
End Sub

Esta macro carga y actualiza los datos del Combobox1 que muestra los nombres de las empresas. Utilizamos ADO para dar mayor rapidez a nuestro proceso.

La segunda macro, no está en un módulo estándar y tampoco está asociada a este botón, sino que está asociada al Combobox1, en concreto al evento Change, esta sería la macro:

Private Sub ComboBox1_Change()
'Definimos las variables
Dim Dataread As Object, obSQL As String
Dim cnn As Object, MiLibro As String, vNombre As String
'Vaciamos combobox2
With Sheets("FACTURA")
.ComboBox2.Clear
'Iniciamos la consulta para mostrar las facturas de la empresa seleccionada
vNombre = .ComboBox1.Value
obSQL = "SELECT [DATOS_FACTURA$].[Nº DE FACTURA] " & _
"FROM [DATOS_FACTURA$] " & _
"Where [DATOS_FACTURA$].[NOMBRE]='" & vNombre & "' " & _
"GROUP BY [DATOS_FACTURA$].[Nº DE FACTURA]"
'Guardamos el nombre del libro activo para utilizarlo en la conexión ADO
MiLibro = ActiveWorkbook.Name
'Iniciamos la conexión ADO
Set cnn = CreateObject("ADODB.Connection")
With cnn
.Provider = "Microsoft.ACE.OLEDB.12.0"
.ConnectionString = "DATA SOURCE=" & Application.ActiveWorkbook.Path + "\" & MiLibro
.Properties("Extended Properties") = "Excel 12.0"
.Open
End With
'Procedemos a grabar los datos de la consulta
Set Dataread = CreateObject("ADODB.Recordset")
With Dataread
.Source = obSQL
.ActiveConnection = cnn
.CursorType = adOpenForwardOnly
.Open
End With
Do Until Dataread.EOF
'Cargamos en el combobox2 listado de facturas dependiendo de la empresa seleccionada
.ComboBox2.AddItem Dataread("Nº DE FACTURA")
Dataread.MoveNext
Loop
'Liberamos y cerramos variables
Dataread.Close: Set Dataread = Nothing
cnn.Close: Set cnn = Nothing
End With
End Sub

Con esta macro, muy similar a la anterior, lo que estamos haciendo es que cada vez que abramos el Combobox2 (el del número de factura), los datos que nos muestre serán todas aquellas facturas que dependan de la empresa seleccionada en el Combobo1, esto lo hacemos con esta instrucción SQL incluida en la macro:

obSQL = "SELECT [DATOS_FACTURA$].[Nº DE FACTURA] " & _
"FROM [DATOS_FACTURA$] " & _
"Where [DATOS_FACTURA$].[NOMBRE]='" & vNombre & "' " & _
"GROUP BY [DATOS_FACTURA$].[Nº DE FACTURA]"

Una vez que hemos actualizado la información, debemos generar la factura, esto lo hacemos con el botón GENERAR FACTURA:

Quizás pueda parecer un proceso complejo, pero en realidad es bastante sencillo en casi todo el código. La macro asociada a está botón de comando es:

Sub GENERAR_FACTURA()
'Declaramos variables
Dim Fin As Long, i As Long, Final As Long, x As Long, j As Long, fInicio As Long
Dim sCantidad As String, sDescripcion As String, sPrecio As String
Dim MatrizCantidad As Variant, MatrizDescripcion As Variant, MatrizPrecio As Variant
'Desactivamos actualización de pantalla
Application.ScreenUpdating = False
'Borramos datos de la factura
With Sheets("FACTURA")
.Range("B8").ClearContents
.Range("B12:B16").ClearContents
.Range("E12:E16").ClearContents
.Range("A21:C21").ClearContents
Final = .Range("A" & Rows.Count).End(xlUp).Row
.Range("A24:F" & Final + 7).Clear
'Obligamos a seleccionar empresa y factura, de lo contrario salimos del proceso
Fin = Application.CountA(Sheets("DATOS_FACTURA").Range("B:B"))
If .ComboBox1.Value = vbNullString Or .ComboBox2.Value = vbNullString Then
MsgBox "DEBES SELECCIONAR UN CLIENTE Y UNA FACTURA, VERIFICA QUE HAS ACTUALIZADO LA INFORMACIÓN", vbExclamation, "SELECCIONAR INFORMACIÓN"
Exit Sub
End If
'Cargamos datos
For i = 2 To Fin
If Trim(Sheets("DATOS_FACTURA").Cells(i, 2)) = .ComboBox2.Value Then
'Fecha factura
.Cells(8, 2) = Sheets("DATOS_FACTURA").Cells(i, 1)
'Nombre,Dirección, Ciudad CP, Teléfono, Email (Facturar a)
.Cells(12, 2) = Sheets("DATOS_FACTURA").Cells(i, 3)
.Cells(13, 2) = Sheets("DATOS_FACTURA").Cells(i, 4)
.Cells(14, 2) = Sheets("DATOS_FACTURA").Cells(i, 5)
.Cells(15, 2) = Sheets("DATOS_FACTURA").Cells(i, 6)
.Cells(16, 2) = Sheets("DATOS_FACTURA").Cells(i, 7)
'Nombre,Dirección, Ciudad CP, Teléfono, Email (Enviar a)
.Cells(12, 5) = Sheets("DATOS_FACTURA").Cells(i, 8)
.Cells(13, 5) = Sheets("DATOS_FACTURA").Cells(i, 9)
.Cells(14, 5) = Sheets("DATOS_FACTURA").Cells(i, 10)
.Cells(15, 5) = Sheets("DATOS_FACTURA").Cells(i, 11)
.Cells(16, 5) = Sheets("DATOS_FACTURA").Cells(i, 12)
'Vendedor, Fecha de envío, Tipo de envío
.Cells(21, 1) = Sheets("DATOS_FACTURA").Cells(i, 13)
.Cells(21, 2) = Sheets("DATOS_FACTURA").Cells(i, 14)
.Cells(21, 3) = Sheets("DATOS_FACTURA").Cells(i, 15)
End If
Next
'Mediante matrices cargamos listado de Cantidades, Descripciones y precios
sCantidad = vbNullString
sDescripcion = vbNullString
sPrecio = vbNullString
For n = 2 To Fin
If .ComboBox2 = Trim(Sheets("DATOS_FACTURA").Cells(n, 2)) Then sCantidad = sCantidad & "|" & Sheets("DATOS_FACTURA").Cells(n, 16)
If .ComboBox2 = Trim(Sheets("DATOS_FACTURA").Cells(n, 2)) Then sDescripcion = sDescripcion & "|" & Sheets("DATOS_FACTURA").Cells(n, 17)
If .ComboBox2 = Trim(Sheets("DATOS_FACTURA").Cells(n, 2)) Then sPrecio = sPrecio & "|" & Sheets("DATOS_FACTURA").Cells(n, 18)
Next n
'Depuramos datos de las variables eliminando la barra al inicio del string
sCantidad = Mid((sCantidad), 2, Len(sCantidad))
sDescripcion = Mid((sDescripcion), 2, Len(sDescripcion))
sPrecio = Mid((sPrecio), 2, Len(sPrecio))
fInicio = 24
'Pasamos los datos de las variables a una matriz y luego a cada elemento de la factura
MatrizCantidad = Split(sCantidad, "|")
MatrizDescripcion = Split(sDescripcion, "|")
MatrizPrecio = Split(sPrecio, "|")
For j = 0 To UBound(MatrizCantidad)
.Cells(fInicio, 1) = MatrizCantidad(j)
.Cells(fInicio, 2) = MatrizDescripcion(j)
.Cells(fInicio, 5) = MatrizPrecio(j) * 1
.Cells(fInicio, 5).NumberFormat = "#,##0.00 $"
fInicio = fInicio + 1
Next j
'Calculamos importe total por unidad y formateamos a moneda
Final = .Range("A" & Rows.Count).End(xlUp).Row
For x = 24 To Final
.Cells(x, 6) = .Cells(x, 1) * .Cells(x, 5)
.Cells(x, 6).NumberFormat = "#,##0.00 $"
Next x
'Aplicamos línea divisoria
Range("A" & Final + 1 & ":" & "F" & Final + 1).Select
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlThin
End With
'Calculamos suma total (Base Imponible)
.Cells(Final + 3, 5) = "Base Imponible:"
.Cells(Final + 3, 6) = Application.WorksheetFunction.Sum(.Range("F24:F" & Final))
.Cells(Final + 3, 6).NumberFormat = "#,##0.00 $"
'Indicamos % de impuesto
.Cells(Final + 4, 6) = .Cells(11, 8)
.Cells(Final + 4, 6).NumberFormat = "0.00%"
'Aplicamos impuesto
.Cells(Final + 5, 5) = "IVA:"
.Cells(Final + 5, 6) = .Cells(Final + 3, 6) * .Cells(Final + 4, 6)
.Cells(Final + 5, 6).NumberFormat = "#,##0.00 $"
'Aplicamos línea divisoria
Range("E" & Final + 5 & ":" & "F" & Final + 1).Select
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlThin
End With
'Obtenemos resultado final
.Cells(Final + 7, 5) = "Total Factura:"
.Cells(Final + 7, 6) = .Cells(Final + 3, 6) + .Cells(Final + 5, 6)
.Cells(Final + 7, 6).NumberFormat = "#,##0.00 $"
.Range("H5").Select
End With
Application.ScreenUpdating = True
End Sub

Está bastante bien comentada, pero básicamente lo que hacemos es borrar toda la información de la factura anterior (si la hubiese) y comprobar que hemos seleccionado datos en los dos ComboBox, si no hay selección, salimos del proceso.

Luego grabamos la información de la hoja FACTURA utilizando varios loop for-next y usamos también un sencillo proceso matricial para colocar todos los elementos de la factura en los apartados de CANTIDAD, DESCRIPCIÓN y PRECIO POR UNIDAD.

A continuación incluimos una serie de instrucciones para calcular el total del precio (multiplicando la cantidad por el precio por unidad). La suma y el porcentaje del impuesto (que debemos indicar en la parte marcada en azul de la hoja).

Formateamos los importes a moneda – euros e incluimos una barra separadora entre los elementos de la factura y los totales.

Por último, he programado un botón para limpiar los datos de la factura, BORRAR DATOS:

Sub BORRAR_FACTURA()
'Declaramos variables
Dim Final As Long
'Borramos todos los datos de la factura
With Sheets("FACTURA")
.ComboBox1 = ""
.ComboBox2 = ""
.Range("B8").ClearContents
.Range("B12:B16").ClearContents
.Range("E12:E16").ClearContents
.Range("A21:C21").ClearContents
Final = .Range("A" & Rows.Count).End(xlUp).Row
.Range("A24:F" & Final + 7).Clear
End With
End Sub

Con este proceso dejamos plantilla totalmente libre de datos.

Os dejo el resultado tras generar la factura 1 de la Empresa A, quedaría así:

GENERAR FACTURAS USANDO VBA2

Por último comentar que si queréis cambiar el formato de la moneda, solo tenéis entrar en la macro GENERAR FACTURA y donde está especificado el formato del euro: .NumberFormat = “#,##0.00 $” realizar el cambio por la moneda que necesitéis.

Como podéis observar, la aplicación funciona perfectamente. He intentado que los códigos no sean demasiado complejos (pero que sean eficientes) y he realizado comentarios para una mejor comprensión.

Por lo tanto, una vez descargado el programa o al abrirlo

Es importante indicar, que la programación hace referencia a celdas específicas y de la hoja FACTURA y también a los nombres y columnas de la hoja DATOS_FACTURA, es decir, que si realizáis modificaciones debéis adaptar el código, de otra forma se producirán errores.

La versión funciona correctamente en archivos .xlsm y en versiones 2010, 2013 y 2016. En versiones anteriores o con formato .xls algunos comandos no son compatibles y podrían ocasiones pérdida de funcionalidad.

Y eso es todo por hoy, espero que os haya gustado este pequeño ejemplo de cómo podemos usar Excel para generar facturas.

Os dejo el archivo de prueba en Google Drive, dado que en WordPress no puedo alojar archivos .xslm

Descarga el archivo de ejemplo pulsando en: GENERAR FACTURAS USANDO VBA, CREAR UN PROGRAMA DE FACTURACIÓN

 

¿Te ha resultado de interés?, puedes apoyar a Excel Signum con una pequeña donación.

Donate Button with Credit Cards

¡¡Muchas gracias!!

ORDENAR LAS PALABRAS DE UNA CELDA ALFABÉTICAMENTE

Saludos a todos 🙂

Espero que vaya muy bien. Hoy vamos a trabajar con matrices en VBA para realizar un ejercicio que suele ser bastante habitual: ordenar el contenido de una celda alfabéticamente. Y resulta útil cuando necesitamos ordenar listados de información, por ejemplo una serie de nombres, de frutas, etc.

Imaginad que tenéis en una serie de celdas la siguiente información:

ORDENAR LAS PALABRAS DE UNA CELDA ALFABETICAMENTE

Efectivamente son tres listados diferentes, con nombres de personas, de frutas y de árboles y sin ningún criterio de ordenación. La tarea es ordenar el contenido de cada celda alfabéticamente, y eso o bien lo hacemos a mano, con una combinación de fórmulas o con VBA. La mejor opción será VBA, ya que construiremos nuestra propia función para resolver este tipo de tareas.

Vamos a usar esta macro:

Function OrdenarAlfa(ByVal Micelda As String)
'Declaramos las variables
Dim Matriz As Object, Palabra As Variant
Dim alfaDato As Variant, iPalabra As String
'Creamos colección arraylist para ir agregando los elementos de la matriz
Set Matriz = CreateObject("System.Collections.ArrayList")
'Por cada objeto/palabra contenida en la celda seleccionada
For Each Palabra In Split(Micelda, " ")
'Añadimos cada palabra a la matriz con un bucle
Matriz.Add Palabra
Next Palabra
'Una vez la matriz creada la ordenamos
Matriz.Sort
'Pasamos los datos ya ordenados a una cadena de texto
For Each alfaDato In Matriz
iPalabra = iPalabra & " " & alfaDato
Next alfaDato
OrdenarAlfa = Trim(iPalabra)
'Limpiamos variable de objeto
Set Matriz = Nothing
End Function

Con esta función (OrdenarAlfa) seleccionamos la celda, pasamos todas las palabras a una matriz, la ordenamos alfabéticamente y luego pasamos los datos ordenados a una cadena (string) que pasamos a la función y por lo tanto a la celda que contiene la fórmula.

En este ejemplo estoy suponiendo que entre cada palabra hay un espacio en blanco, si la separación fuese una coma “,” (o cualquier otro símbolo), solo tenéis que cambiarlo en la macro en esta línea:

For Each Palabra In Split(Micelda, ",")

Y si queréis que las palabras resultantes de la fórmula también tengan una coma de separación, debéis cambiarlo en esta otra línea:

iPalabra = iPalabra & ", " & alfaDato

y modificar el dato que pasa a la función:

OrdenarAlfa = Trim(Mid(iPalabra, 2, Len(iPalabra)))

El resultado es el siguiente:

ORDENAR LAS PALABRAS DE UNA CELDA ALFABETICAMENTE1

Ya tenemos todas las informaciones ordenadas alfabéticamente y con la ayuda de una nueva función. Obviamente, la podéis adaptar a un proceso automático o para mostrar los datos en un formulario, las posibilidades son muchas.

Y eso es todo, espero que os resulte de interés 🙂

Descarga el archivo de ejemplo pulsando en: ORDENAR LAS PALABRAS DE UNA CELDA ALFABETICAMENTE

¿Te ha resultado de interés?, puedes apoyar a Excel Signum con una pequeña donación.

Donate Button with Credit Cards

¡¡Muchas gracias!!

UTILIZAR UNA MATRIZ EN UN LOOP FOR – NEXT

Hola a todos 😉

¿Qué tal os va?, espero que muy bien!

Hoy os voy a realizar un sencillo ejemplo de cómo podemos utilizar una matriz en un loop for-next. Esto viene por una consulta de un lector que me preguntaba acerca de cómo podía utilizar una matriz en un bucle.

En Excel Signum hay varios post dedicados a tipos de bucles o loops, algo fundamental en la programación y en el análisis de datos en particular. Os invito a que les echéis un vistazo.

Vamos a ver un ejemplo con el que podamos utilizar un for y también una matriz para determinar el inicio y fin de ese proceso. Imaginad que tenéis un listado con los siguientes campos, ID, NOMBRE COMPLETO Y FECHA DE NACIMIENTO:

UTILIZAR UNA MATRIZ EN UN LOOP FOR - NEXT

Y debemos indicar la edad de cada persona en la columna EDAD. Para hacerlo vamos a utilizar un código que he programado y que nos incorporará la edad con un formato muy particular. Esta es la macro que vamos a utilizar:

Sub MATRIZ_EN_LOOP()
'Definimos variables
Dim i As Integer, fin As Long, hoy As String, f_nac As String
Dim año As Integer, mes As Integer, dia As Integer
Dim Matriz As Variant
'Seleccionamos la hoja1
With Sheets("Hoja1")
fin = .Range("A" & Rows.Count).End(xlUp).Row
'Componemos la matriz a partir del rango definido
Matriz = .Range("A1:A" & fin)
'Iniciamos el loop for-next utilizando la variable matriz para definir el inicio y el final
For i = LBound(Matriz) + 1 To UBound(Matriz)
'Indicamos la fecha de hoy con formato mm/dd/aaaa y lo componemos en un string
hoy = (Month(Date) & "/" & Day(Date) & "/" & Year(Date))
'Indicamos la fecha de nacimiento con formato mm/dd/aaaa y lo componemos en un string
f_nac = (Month(.Cells(i, 3).Value) & "/" & Day(.Cells(i, 3).Value) & "/" & Year(.Cells(i, 3).Value))
'Evaluamos la función Datedif para año, mes y día
año = Evaluate("DATEDIF(""" & f_nac & """,""" & hoy & """,""Y"")")
mes = Evaluate("DATEDIF(""" & f_nac & """,""" & hoy & """,""YM"")")
dia = Evaluate("DATEDIF(""" & f_nac & """,""" & hoy & """,""MD"")")
'Pasamos el string con los años, meses y días de nuestra edad actual a la columna 4
.Cells(i, 4) = año & IIf(año = 1, " año", " años") & ", " & mes & IIf(mes = 1, " mes", " meses") & " y " & dia & IIf(dia = 1, " dia", " días")
Next i
End With

Antes de ver el resultado conviene comentar la forma en la que pasamos un rango a una matriz:

Matriz = .Range("A1:A" & fin)

Declarando la variable Matriz como variant e igualandola a un rango (dinámico), ya podemos introducirla en el bucle for:

For i = LBound(Matriz) + 1 To UBound(Matriz)

La función LBound nos devuelve el menor subíndice disponible para la dimensión indicada de la matriz, el valor que siempre va a retornar será el 0, pero en este caso, debemos sumarle un 1, dado que tenemos encabezados en cada columna. Si empezásemos con una fecha directamente (sin encabezados), eliminamos el +1.

La función UBound nos devuelve el mayor subíndice disponible para la dimensión indicada de la matriz.

Entonces ya tenemos todos los componentes necesarios para hacer funcionar nuestro loop. En el resto de la macro he re-adaptado el código de otra entrada anterior: CALCULAR LA EDAD CON DATEDIF EN UN FORMULARIO DE EXCEL, pero para que funcione en una hoja en lugar de un formulario.

El resultado de aplicar la macro es el siguiente:

UTILIZAR UNA MATRIZ EN UN LOOP FOR - NEXT1

Es un ejemplo sencillo pero es fundamental para comprender la funcionalidad que nos pueden otorgar las matrices y algunas de las funciones con las que las tratamos (LBoung, UBound).

Espero que os haya resultado de interés!.

Descarga el archivo de ejemplo pulsando en: UTILIZAR UNA MATRIZ EN UN LOOP FOR – NEXT

 
¿Te ha resultado de interés?, puedes apoyar a Excel Signum con una pequeña donación.

Donate Button with Credit Cards

¡¡Muchas gracias!!

PASAR DATOS DE UNA CADENA DE TEXTO O NUMÉRICA A UN RANGO VARIABLE USANDO MATRICES

Hola a todos : )

Aunque hoy no tenía pensado publicar nada, al final ayer por la noche me lié a escribir una macro, y la razón fue pensando acerca de los currículums, los historiales o cualquier informe que implique mostrar datos que vienen de rangos que pueden ser variables.

Por ejemplo, datos sobre los idiomas que sé, los estudios que tengo o los departamentos por lo que he pasado. Imaginad que tenéis que hacer una hoja resumen en la que se deban mostrar esos datos, o para resumir, los datos de los idiomas que sabéis.

De tal forma que si escribís el nombre de un empleado en una celda, la macro os “traiga” todos los idiomas pero en un rango determinado, dependiendo de la cantidad de lenguas que sepáis.

Como no tengo demasiado tiempo para componer bases de datos nuevas, voy a echar mano de misma tabla que en el post anterior

CONCATENAR INFORMACION DE VARIOS REGISTROS DUPLICADOS EN UNA CELDA

De lo que se trata es de conseguir que en la hoja (RESULTADO) cuando escribamos un nombre que exista en la hoja datos, nos devuelva todos los idiomas que sabe en un rango de filas, por ejemplo, vamos a elegir a RAMÓN:

PASAR DATOS DE UNA CADENA DE TEXTO O NUMERICA A UN RANGO VARIABLE USANDO MATRICES

Esto lo vamos a conseguir con este código:

Sub PASAR_A_RANGO_VARIABLES_CON_MATRICES()
'Declaramos las variables
Dim i As Integer, j As Integer
Dim finRes As Integer, finDat As Integer, fInicio As Integer
Dim sIdioma As String, sNivel As String
Dim MatrizIdioma As Variant, MatrizNivel As Variant
'Borramos datos en hoja RESULTADO
finDat = Application.CountA(Sheets("DATOS").Range("A:A"))
If finDat > 0 Then Sheets("RESULTADO").Range("B2:C" & finDat).Clear
With Sheets("RESULTADO")
'Vaciamos las variables utilizadas al inicio de cada búsqueda
sIdioma = vbNullString
sNivel = vbNullString
'Iniciamos un segundo loop buscando coincidencia de nombre con la hoja datos
'Si existe componemos un string en las variables sIdioma y sNivel
For i = 2 To finDat
'Extraemos Idioma
If UCase(.Cells(2, 1)) = Sheets("DATOS").Cells(i, 1) Then sIdioma = sIdioma & "," & Sheets("DATOS").Cells(i, 2)
'Extraemos Nivel
If UCase(.Cells(2, 1)) = Sheets("DATOS").Cells(i, 1) Then sNivel = sNivel & "," & Sheets("DATOS").Cells(i, 3)
Next i
'Depuramos datos de las variables eliminando la coma al inicio del string
sIdioma = Mid((sIdioma), 2, Len(sIdioma))
sNivel = Mid((sNivel), 2, Len(sNivel))
fInicio = 2
'Pasamos los datos de las variables a una matriz y luego a la hoja RESULTADO
MatrizIdioma = Split(sIdioma, ",")
MatrizNivel = Split(sNivel, ",")
For j = 0 To UBound(MatrizIdioma)
.Cells(fInicio, 2) = MatrizIdioma(j)
.Cells(fInicio, 3) = MatrizNivel(j)
fInicio = fInicio + 1
Next j
End With
End Sub

Como podéis ver, primero pasamos todos los idiomas y su nivel a una cadena de texto y delimitamos cada información con una coma “,”. Luego lo pasamos a una matriz y a través de un segundo loop pasamos los datos a cada celda. De esta forma podemos ir colocando cada uno de los idiomas que tenga un empleado ocupe el rango que ocupe, (es decir, siempre sabremos cuantas celdas debemos rellenar).

Este es un ejemplo sencillo, pero muy importante cuando tenemos que confeccionar fichas, históricos, resúmenes e informes individuales.

Solo tenéis que introducir un nombre y pulsar en el botón para mostrar sus idiomas y el nivel que posee en cada uno.

Os dejo el archivo del ejemplo para que realicéis pruebas y lo podáis adaptar a vuestros proyectos y trabajos.

Descarga el archivo de ejemplo pulsando en: PASAR DATOS DE UNA CADENA DE TEXTO O NUMÉRICA A UN RANGO VARIABLE USANDO MATRICES

 
¿Te ha resultado de interés?, puedes apoyar a Excel Signum con una pequeña donación.

Donate Button with Credit Cards

¡¡Muchas gracias!!

EXTRAER REGISTROS ÚNICOS DE UN RANGO DE DATOS

Aunque normalmente no tengo mucho tiempo, a veces entro en algunos foros de Excel y contesto algunas de las preguntas que realizan los lectores. Esto es muy positivo, siempre encuentras nuevas ideas para desarrollar y hechas una mano a otras personas.

La última consulta que respondí iba sobre la posibilidad de extraer registros únicos pero no de una columna sino de un rango de datos. Es decir, seleccionar un rango de celdas y extraer los registros únicos.

Esta tarea se puede hacer de varias formas, en esta ocasión lo implementaré con matrices en VBA y finalmente aplicaremos quitar duplicados.

Como siempre vamos a usar un ejemplo: voy a pegar varias columnas (tres, por ejemplo) sobre las que seleccionaré el rango sobre el que extraer la información:

EXTRAER REGISTROS UNICOS DE UN RANGO DE DATOS1

A continuación debemos pegar la macro que realizará el trabajo:

Sub EXTRAER_UNICOS()
'Definimos variables
Dim i As Long, fin As Long
Dim rng As Range, celda As Range
Dim final As Long
Dim matriz() As Variant
'Desactivamos actualización de pantalla
Application.ScreenUpdating = False
'Trabajamos con la hoja activa
With ActiveSheet
'Limpiamos datos en la columna E
.Columns("E:E").ClearContents
'Capturamos selección y contamos registros
i = 1
Set rng = Selection
fin = rng.Count
'Redimensionamos la matriz
ReDim matriz(1 To fin)
'Con un loop grabamos los datos de cada celda
'y los pasamos a la columna E

For Each celda In rng
matriz(i) = celda.Value
i = i + 1
Next celda
For i = LBound(matriz) To UBound(matriz)
.Cells(i, 5) = matriz(i)
Next i
'Eliminamos duplicados de la columna E
final = .Cells(Rows.Count, "E").End(xlUp).Row
'Si no hay datos en la columna E salimos del proceso
If final = 1 Then Exit Sub
.Range("E1:E" & final).RemoveDuplicates Columns:=1, Header:=xlNo
'Ordenamos los datos, centrados y ascendentes
With .Columns("E:E")
.Select
.HorizontalAlignment = xlCenter
End With
.Sort.SortFields.Clear
.Sort.SortFields.Add Key:=Range("E1:E" & final), _
SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
With .Sort
.SetRange Range("E1:E" & final)
.Header = xlGuess
.MatchCase = False
.Orientation = xlTopToBottom
.Apply
End With
.Range("E1").Select
End With
Application.ScreenUpdating = True
End Sub

Ahora que ya tenemos la macro, solo tenemos que seleccionar los datos y pulsar en el botón de comando. El resultado lo pasará a la columna “E” o “5” (podéis especificar el destino que mejor se adapte a vuestras necesidades indicándolo en el código).

Y ya tenemos los datos:

EXTRAER REGISTROS UNICOS DE UN RANGO DE DATOS2

Dado que estamos trabajando con matrices, debéis tener en cuenta que tienen ciertos límites (por ejemplo, si seleccionamos toda la hoja, mostrará un error).

Y eso es todo por hoy, espero que os sea de utilidad. Por supuesto, en este ejemplo obtenemos los datos de una selección, pero se podría definir un rango perfectamente.

Descarga el archivo de ejemplo pulsando en: EXTRAER REGISTROS ÚNICOS DE UN RANGO DE DATOS