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!!

Anuncios

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!!

INVERTIR EL ORDEN DE LOS CARACTERES DE UNA CADENA DE TEXTO O NUMÉRICA

Hola a todos:

Esta semana he tenido muy poco tiempo para escribir nuevos post, han sido muchas consultas y algunas me han llevado más tiempo de lo que había previsto.

No obstante, hoy voy a escribir una pequeña entrada sobre una función que resulta muy útil para aquellas tareas en las necesitemos invertir el orden de los caracteres de una cadena de texto.

Usando matrices y bucles también se podría llegar al mismo resultado, pero cuando ya existe en VBA una función específica, lo más eficiente es usarla 🙂

Vamos, imaginad que tenéis las siguientes frases en vuestra hoja Excel:

INVERTIR EL ORDEN DE LOS CARACTERES DE UNA CADENA DE TEXTO O NUMERICA

y necesitáis escribir ese texto al revés, es decir, invertir el orden de los caracteres que lo componen, por ejemplo, EXCEL SIGNUM quedaría así: MUNGIS LECXE (un poco difícil de pronunciar 🙂 .

Pues bien, para realizar este trabajo, vamos a usar una UDF (Función Definida por el Usuario):

Function Invertir(ByVal Micelda As String)
Invertir = StrReverse(Micelda)
End Function

Ahora podemos escribir nuestra función en la barra de fórmulas de nuestra hoja (Invertir) y nos aparecerá como cualquier otra, y donde solo tenemos un argumento, que es la celda seleccionada:

INVERTIR EL ORDEN DE LOS CARACTERES DE UNA CADENA DE TEXTO O NUMERICA1

El resultado será este:

INVERTIR EL ORDEN DE LOS CARACTERES DE UNA CADENA DE TEXTO O NUMERICA2

Como podéis observar con tres líneas de código realizamos la tarea rápidamente, sin necesidad de acudir a fórmulas matriciales complejas ni bucles que ralentizarían nuestro trabajo.

Ah, se me olvidaba, no queréis espacios en blanco entre las palabras, simplemente los elimináis:

Invertir = StrReverse(Replace(Micelda, " ", ""))

Y eso es todo por hoy. Espero que os sea de utilidad para temas de codificaciones o seguridad informática.

Descarga el archivo de ejemplo pulsando en: INVERTIR EL ORDEN DE LOS CARACTERES DE UNA CADENA DE TEXTO O NUMÉRICA

¿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!!

CONCATENAR INFORMACIÓN DE VARIOS REGISTROS DUPLICADOS EN UNA CELDA

Hola a todos, ¿qué tal estáis?: Espero que bien!

Cuando tenemos que incorporar datos de varias columnas o filas en una celda, solemos usar la función concatenar o el ampersand “&“.

Pero esta tarea se dificulta bastante cuando lo que tenemos que concatenar son informaciones de varios rangos vinculadas a registros duplicados (y tenemos gran cantidad de información).

Esto lo entenderéis mejor con un ejemplo visual. Imaginad que tenemos la información de varios empleados de unos grandes almacenes con el idioma y el nivel asociado:

CONCATENAR INFORMACION DE VARIOS REGISTROS DUPLICADOS EN UNA CELDA

Como podéis observar, se han abierto tantos registros como idiomas sepa el empleado (habitual en el uso de bases de datos).

Y lo que queremos conseguir es, por ejemplo, para el primer empleado:

CONCATENAR INFORMACION DE VARIOS REGISTROS DUPLICADOS EN UNA CELDA2.jpg

Efectivamente, debemos pasar los datos de los rangos vinculados a cada empleado y crear una cadena de texto (string) que pueda expresar la información que necesitamos.

Para ello vamos a usar la siguiente macro que he preparado para ayudarnos en esta tarea:

Sub CONCATENAR_DUPLICADOS_EN_CELDA()
'Declaramos las variables
Dim i As Integer, j As Integer
Dim finRes As Integer, finDat As Integer
Dim sCadena As String, Lista As Range, Unicos As Range
'Borramos datos en hoja RESULTADO
finDat = Application.CountA(Sheets("DATOS").Range("A:A"))
If finDat > 0 Then Sheets("RESULTADO").Range("A1:B" & finDat).Clear
'Pasamos registros únicos de nombres a la columna A de hoja RESULTADO
Set Lista = Sheets("DATOS").Range("A1:A" & finDat)
Set Unicos = Sheets("RESULTADO").Range("A1:A" & finDat)
Lista.AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Unicos, Unique:=1
'Indicamos título y negrita para encabezado segunda columna
With Sheets("RESULTADO")
.Cells(1, 2) = "IDIOMAS Y NIVEL"
.Cells(1, 2).Font.Bold = True
End With
'Iniciamos loop por cada registro único
finRes = Application.CountA(Sheets("RESULTADO").Range("A:A"))
With Sheets("DATOS")
For i = 2 To finRes
'Vaciamos la variable sCadena en cada loop
sCadena = vbNullString
'Iniciamos un segundo loop buscando coincidencia de nombre con la hoja datos
'Si existe componemos un string en variable scadena con los datos que deseamos
For j = 2 To finDat
If Sheets("RESULTADO").Cells(i, 1) = .Cells(j, 1) Then sCadena = sCadena & ", " & .Cells(j, 2) & ": Nivel " & .Cells(j, 3)
Next j
'Pasamos los datos de la variable a la hoja RESULTADO
Sheets("RESULTADO").Range("B" & i) = Trim(Mid((sCadena), 2, Len(sCadena)))
Next i
End With
'Mostramos datos y liberamos variables
Sheets("RESULTADO").Select
Set Lista = Nothing
Set Unicos = Nothing
End Sub

El resultado es el siguiente:

CONCATENAR INFORMACION DE VARIOS REGISTROS DUPLICADOS EN UNA CELDA3

Aunque ya lo comento en el código, básicamente lo que hacemos es grabar en la variable “scadena” toda la información relativa a cada empleado mediante dos loop y luego formateamos según nuestras necesidades.

Es un proceso sencillo y estoy seguro que en más de una ocasión os será de utilidad.

Y eso es todo por hoy, saludos y que tengáis un buen fin de semana!!

Descarga el archivo de ejemplo pulsando en: CONCATENAR INFORMACIÓN DE VARIOS REGISTROS DUPLICADOS EN UNA CELDA

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

Donate Button with Credit Cards

¡¡Muchas gracias!!

 

SELECCIONAR NÚMEROS Y CONVERTIRLOS A ENTERO CON VBA

Hola a todos!!

Hoy publicaré un post en el que vamos a crear un código que nos permita pasar números con decimales (positivos o negativos) a un número entero, es decir, el número sin sin decimales ni redondeos. El motivo es que hace unos días un lector me pidió eso exactamente.

Para realizar este ejercicio utilizaremos este ejemplo:

SELECCIONAR NUMEROS Y CONVERTIRLOS A ENTERO CON VBA

Como podéis ver, tenemos una mezcla de números (positivos, negativos, con decimales o enteros). Y ahora debemos realizar lo que nuestro compañero lector nos ha pedido, solo enteros y respetando el signo del número.

Para hacerlo utilizaremos este código:

Sub CONVERTIR_SELECCION_A_ENTERO()
Dim i As Range, Area As Object
With Sheets("Hoja1")
'Incluimos un control error en caso de ejecutar la macro sin seleccionar datos
On Error GoTo Control
'Área será el rango que vayamos a seleccionar
Set Area = Application.Intersect(Selection, .UsedRange)
'Iniciamos un bucle que recorra cada uno de las celdas en el "área" seleccionada
For Each i In Area
'Si el número no es entero entonces los pasamos a entero
If i CInt(i) Then i = CInt(Fix(i))
'Ocultamos los ceros que quedan "vacíos" después de pasar a entero
Selection.NumberFormat = "0"
Next i
Control: If Err.Number = "424" Then
MsgBox ("EL RANGO SELECCIONADO NO CONTIENE DATOS"), vbExclamation, "SIN DATOS SELECCIONADOS"
End If
End With
End Sub

Una vez aplicada la macro este es el resultado:

SELECCIONAR NUMEROS Y CONVERTIRLOS A ENTERO CON VBA1

Efectivamente, hemos pasado todos los números a entero, y hemos utilizado la función Fix para que respete el signo de los números negativos y que además elimine todos los números después de la coma, dejando el número principal sin redondeos.

Y eso es todo, os dejo el archivo para que realicéis pruebas 🙂

Descarga el archivo de ejemplo pulsando en: SELECCIONAR NÚMEROS Y CONVERTIRLOS A ENTERO CON VBA

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

Donate Button with Credit Cards

¡¡Muchas gracias!!