jueves, 25 de enero de 2018

VBA: Otra forma de cargar y eliminar elementos de un ListBox

En la entrada anterior vimos cómo emplear el método .RemoveItem para eliminar elementos de un ListBox cargados con .AddItem...

Hoy veremos una alternativa a la carga de datos en un ListBox a partir de datos en la hoja de cálculo, y cómo gestionar su borrado.


Partimos de una tabla de países (TblPaises) en la hoja de cálculo y un UserForm creado que contiene un ListBox al que hemos renombrado como 'LstPais'.

VBA: Otra forma de cargar y eliminar elementos de un ListBox



El trabajo consiste en cargar el ListBox en el evento _Initialize del formulario, lo que conseguimos al emplear la propiedad .List y llevar a este 'lista' el rango indicado (Range("TblPaises[paises]")).

Por otra parte en el procedimiento 'RecargaListBox' procedemos a redefinir el rango continuo o discontinuo de celdas resultate después de eliminar un elemento del ListBox.

El rango resultante será cargado de nuevo en el ListBox a través del evento _DblClick, donde se produce el control de borrado o carga de elementos...


Así pues añadimos los siguiente códigos dentro de la ventana de código de nuestro UserForm en nuestro proyecto de VB:

Dim rngPaises As Range

Private Sub UserForm_Initialize()
With Range("TblPaises[paises]")
    'Llenamos el ListBox LstPais con los elementos del rango
    Me.LstPais.List = Application.Transpose(.Cells)
    'Cargamos el rango con los paises que aparecen en esas celdas
    Set rngPaises = .Cells
End With
End Sub
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Private Sub LstPais_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
Dim i As Long
Dim filas As String

For i = (Me.LstPais.ListCount) To 1 Step -1
    If Me.LstPais.Selected(i - 1) = True Then
        'eliminamos el elemento seleccionado
        Me.LstPais.RemoveItem (i - 1)
    Else
        'con el resto obtenemos una cadena de texto con los número de filas con datos
        filas = filas & (i + 1) & "-"
    End If
    'deseleccionamos el elemento activo después del borrado
    On Error Resume Next
    Me.LstPais.Selected(Me.LstPais.ListCount - 1) = False
    On Error GoTo 0
Next i
'en caso la cadena de texto 'filas' tenga contenido
'quitamos el último caracter/separador añadido...
If Not filas = "" Then RecargaListBox Left(filas, Len(filas) - 1)
End Sub
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Sub RecargaListBox(filas As String)
Dim addr As String
Dim ifila As Variant
'declaramos una matriz para cargarla con las direcciones de las celdas con datos
Dim arrFila As Variant

'partimos en elementos individuales la cadena de celdas..
arrFila = Split(filas, "-")
For ifila = UBound(arrFila) To LBound(arrFila) Step -1
    addr = addr & rngPaises.Item(arrFila(ifila)).Address & ","
Next ifila

'en caso la cadena de texto 'addr' tenga contenido
'quitamos el último caracter/separador añadido...
If Not addr = "" Then addr = Left(addr, Len(addr) - 1)
'recargamos el rango con los paises resultantes...
Set rngPaises = rngPaises.Parent.Range(addr)
End Sub



Se puede comparar con el resultado de la entrada anterior, y comprobarse que es similar...

martes, 23 de enero de 2018

VBA: Borrar elementos de un ListBox-.RemoveItem

Veremos una sencilla forma de eliminar elementos dentro de un ListBox en un UserForm (formulario de usuario), siempre y cuando se hayan cargado empleando el método .AddItem !!...
Esto, por tanto, no será válido para datos cargados con la propiedad .RowSource.


Tenemos un formulario con un ListBox llamado 'LstPais'

VBA: Borrar elementos de un ListBox



Para cargar los datos desde nuestra Tabla de países en la hoja de cálculo, asociaremos al evento _Initialize con el método .AddItem.
Mientras que asociado al evento Doble Clic (_DblClick) conseguiremos que el elemento sobre el que realicemos dicha acción se elimine...


Así pues añadimos los siguiente códigos dentro de la ventana de código de nuestro UserForm en nuestro proyecto de VB:

Private Sub UserForm_Initialize()
'recorremos cada celda del campo pais de nuestra Tabla
For Each pais In Range("TblPaises[paises]")
    'lo incorporamos como elemento nuevo del ListBox
    'empleando el método .AddItem
    Me.LstPais.AddItem pais.Value
Next pais
End Sub

Private Sub LstPais_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
'condicionamos al evento Doble Clic el borrado del elemento
'si hay algo seleccionado lo borramos
If Me.LstPais.ListIndex >= 0 Then
    'con el método .RemoveItem eliminamos el elemento
    Me.LstPais.RemoveItem (Me.LstPais.ListIndex)
End If

End Sub



Podemos ejecutar nuestro formulario y comprobar el correcto uso...

VBA: Borrar elementos de un ListBox

jueves, 18 de enero de 2018

Doble búsqueda con cálculo condicionado

Resolveremos hoy un problema interesante de búsqueda múltiple con el matiz que se condiciona el cálculo a devolver.
Veamos el planteamiento para entender algo mejor el problema:



La idea es obtener, según la matriz de información en B3:E6, y para cada registro de la tabla principal en H3:J18 la fecha de vencimiento correspondiente a las condiciones de B3:E6.
Por ejemplo, el primer registro corresponde a
-la Categoría: cat1
-el Concepto: conc1
al que se le aplicará un vencimiento de 15 días;
en nuestro ejemplo habrá que sumar a 28/06/2017 + 15 días con resultado: 13/07/2017.
En otros registros, se sumarán meses naturales o años completos...
Esto es, el cálculo variará según el tipo de intervalo (día, mes, año).


Esta doble búsqueda la gestionaremos con las funciones INDICE y COINCIDIR pero matricialmente ejecutadas... lo que nos permitirá recuperar del rango B3:E6 por un lado las uds y por otro el tipo (día, mes o año).

Veamos nuestras formulaciones, en K3 insertamos (recuerda validar presionando Ctrl+Mayusc+Enter):
=SI.ERROR(INDICE($E$3:$E$6;COINCIDIR($H3&$I3;$B$3:$B$6&$C$3:$C$6;0));"")
la clave del asunto es que concatenando elementos de Categoría + Concepto podremos recuperar el valor deseado...

Luego podremos copiar la fórmula al resto del rango: K4:K18.



De forma similar para el siguiente dato en L3 insertamos (validar con Ctrl+Mayusc+Enter):
=SI.ERROR(INDICE($D$3:$D$6;COINCIDIR($H3&$I3;$B$3:$B$6&$C$3:$C$6;0));0)

y copiamos al resto del rango L4:L18.


Con los valores recuperados de 'Tipo' y 'Uds' ya estamos en disposición de calcular el vencimiento de cada registro...
En M3:
=SI.ERROR(ELEGIR(COINCIDIR(K3;{"día";"mes";"año"};0);J3+L3;FECHA.MES(J3;L3);FECHA.MES(J3;12*L3));"")



Lo interesante de esta fórmula ELEGIR es que a partir del 'Tipo' recuperado con la matricial anterior,
nos permite seleccionar qué cálculo realizar:
ELEGIR(COINCIDIR(K3;{"día";"mes";"año"};0);J3+L3;FECHA.MES(J3;L3);FECHA.MES(J3;12*L3))
la función COINCIDIR sobre la constante matricial {"día";"mes";"año"} devuelve un número índice 1,2 ó 3, que tomaremos como indicador de posición para optar por un cálculo u otro.
Si la coincidencia del tipo es 1, i.e., el 'Tipo' es día, entonces calcularemos: J3+L3 (fecha + Uds)
Si la coincidencia del tipo es 2, i.e., el 'Tipo' es mes, entonces calcularemos: FECHA.MES(J3;L3) (sumamos x meses a la fecha)
Si la coincidencia del tipo es 3, i.e., el 'Tipo' es año, entonces calcularemos: FECHA.MES(J3;12*L3) (sumamos x años a la fecha)


Con la función SI.ERROR gestionamos en todos los casos el error en las búsquedas...

martes, 16 de enero de 2018

Pasar una matriz de varias columnas a un vector de una sola columna

Hace algunos días me llegó a través de un comentario una cuestión clásica en Excel:
Cómo pasar una matriz de varias columnas a un vector de una sola columna



Lo haremos de un par de formas.
Una primera con fórmulas.
En primer lugar hemos asignado un nombre definido al rango de celdas con valores:
datos =Hoja2!$A$2:$B$11

A partir de ese nombre definido, en las celda E2:E21, añadimos la siguiente fórmula:
=INDICE(datos;1+ENTERO((FILA(A1)-1)/COLUMNAS(datos));RESIDUO(FILA(A1)-1+COLUMNAS(datos);COLUMNAS(datos))+1)
algo larga, pero lo relevante es que con la fórmula:
1+ENTERO((FILA(A1)-1)/COLUMNAS(datos))
obtenemos la posición de las filas a recuperar del rango 'datos', aumentando el número de fila de dos en dos.

De forma similar con
RESIDUO(FILA(A1)-1+COLUMNAS(datos);COLUMNAS(datos))+1
obtenemos la posición de la columna, para nuestro ejemplo, 1, 2, 1, 2, 1, 2, etc...

Según se ve en la imagen siguiente:



Se observa como los algoritmos empleados devuelven el recorrido ordenado de cada elemento de nuestra matriz...

Otra forma, quizá mas simple, sea empleando una macro, así añadiremos dentro de un módulo estándar de nuestro proyecto de VB:

Sub ConvertirMatrizVector()
'pedimos al usuario selecciona la primera celda donde desplegar el vector destino
Set celdadestino = Application.InputBox("Celda Inicio Destino:", Type:=8)

Dim fd As Long
fd = 0
'recorremos fila por fila del rango seleccionado
For Each fila In Selection.Rows
    'copiamos la fila completa
    fila.Copy
    'y pegamos en el destino adecuado
    celdadestino.Offset(fd, 0).PasteSpecial Paste:=xlValues, Transpose:=True
    'incrementando la posición de fila destino...
    fd = fd + fila.Columns.Count
Next fila
End Sub



O también esta otra macro.

Sub ConvertirMatrizVector_v2()
'pedimos al usuario selecciona la primera celda donde desplegar el vector destino
Set celdadestino = Application.InputBox("Celda Inicio Destino:", Type:=8)

Dim fd As Long
fd = 0
'recorremos las filas del rango seleccionado
For f = 1 To Selection.Rows.Count
    'y recorremos las columnas del rango seleccionado
    For c = 1 To Selection.Columns.Count
        'llevamos el valor de cada celda del rango a la celda destino
        celdadestino.Offset(fd, 0).Value = Selection.Cells(f, c).Value
        fd = fd + 1
    Next c
Next f
End Sub



Consiguiendo en cualquiera de los tres casos el objetivo: convertir una matriz en un vector

jueves, 11 de enero de 2018

VBA: Limitar elementos de un ComboBox a la lista cargada

Se trata hoy de limitar qué elementos podemos insertar en un ComboBox dentro del contexto de formulario de usuario, para evitar incluir elementos fuera de la lista permitida.

Para mostrar estas propiedades ejercitaremos un ejemplo de búsqueda de datos desde un Userform.
Tenemos un listado de datos en A1:D19, con campos ID, Fecha, Concepto e Importe.
A partir del ID en un ComboBox rellenaremos tres TextBox.
Lo importante es que queremos controlar que el ComboBox asociado al ID se rellena solo con los datos habilitados.


Nuestros datos en la hoja de cálculo:

VBA: Limitar elementos de un ComboBox a la lista cargada



Por otro lado insertaremos un UserForm en nuestro proyecto, con
1- cuatro etiquetas - label,
2- tres TextBox:
txtFecha
txtConcepto
txtImporte
3- un CommandButton
cmdSalir
4- un ComboBox
cmbID

VBA: Limitar elementos de un ComboBox a la lista cargada



Lo importante será las propiedades del ComboBox a tocar para conseguir nuestro objetivo:
.MatchRequired = True
.Style = 2-fmStyleDropDownList
Modificando estas dos propiedades conjuntamente (recomendado) conseguimos la meta, y nos será imposible introducir un elemento fuera de los listados...

Estas propiedades del Combobox las podemos ajustar desde la ventana de propiedades del Control, o bien desde la programación, como se puede ver a continuación

En la ventana de código del UserForm incluimos:

Private Sub UserForm_Initialize()
'ajustamos propiedades para evitar introducir elementos fuera de la lista mostrada
Me.cmbID.MatchRequired = True
Me.cmbID.Style = fmStyleDropDownList
'cargamos los elementos del rango A2:A19
Me.cmbID.RowSource = "A2:A19"
End Sub
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Private Sub cmbID_Change()
'limpia los campos informados
Me.txtFecha.Value = ""
Me.txtConcepto.Value = ""
Me.txtImporte.Value = ""

'gestiona la búsqueda del ID deseado
Dim fila As Long
fila = Range("A2:A19").Find(what:=Me.cmbID.Value).Row

'carga los TextBox con valores de la lista...
Me.txtFecha.Value = CDate(Cells(fila, "B").Value)
Me.txtConcepto.Value = CStr(Cells(fila, "C").Value)
Me.txtImporte.Value = Format(CDbl(Cells(fila, "D").Value), "#,##0")

End Sub
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Private Sub cmdSalir_Click()
'descarga y cierra el UserForm
Unload Me
End Sub



El resultado es el esperado... se nos hace imposible meter valores en el ComboBox distintos de los listados...

martes, 9 de enero de 2018

Replicar información de filas en columnas

Hoy haremos uso de las funciones matriciales para cruzar información insertada en filas en las columnas correspondientes, esto es, replicar los datos de filas en columnas.
Veamos en la imagen siguiente la idea:

Replicar información de filas en columnas



Se observa que al introducir un dato en C5, la formulación devuelve el dato en su correspondiente cruce, en la celda F4.
El tema de esta formulación es cruzar compras-ventas entre empresas, y que obviamente, una compra de A a B representa en el mismo instante una venta de B hacia A...


Nuestra fórmula matricial insertada en D5 será:
=INDICE(SI($C$3:$J$3="compra";DESREF($B$3;COINCIDIR(C$2;$B$4:$B$7;0);1;1;8));2*FILAS($B$4:$B5)-1)
recuerda validarla presionando Ctrl+Mayusc+Enter, en vez de solo Enter.

Esta formula la copiaremos al resto de celdas de las columnas que responde al concepto 'venta'.


Expliquemos algo más de esta fórmula.



Comprobamos el hecho que:
La empresa A ha comprado a B por 500
La empresa C ha comprado a B por 600
La empresa D ha comprado a B por 100
lo que provoca inmediatamente y en sentido contrario que:
La empresa B ha vendido a A por 500
La empresa B ha vendido a C por 600
La empresa B ha vendido a D por 100.

En nuestra fórmula empleamos la función DESREF que nos habilita un rango virtual que corresponde a la fila de valores correspondiente a la empresa que vende.
Por ejemplo, en la celda F4
DESREF($B$3;COINCIDIR(E$2;$B$4:$B$7;0);1;1;8)
se convierte en
{500\0\0\0\600\0\100\0}
al aplicar sobre esta matriz un condicional (no sería estrictamente necesario) para quedarnos con los valores de 'compra' tendríamos la siguiente matriz de valores:
{500\FALSO\0\FALSO\600\FALSO\100\FALSO}

Como solo queremos recuperar los valores que responden a las posiciones impares, para recuperarlos con la función INDICE añadiremos como argumento la serie de los impares:
2n-1
o en nuestro caso:
2*FILAS($B$4:$B5)-1


Como se comentaba más arriba, se podría optar por esta forma igualmente válida y algo más sencilla en la celda D5:
=INDICE(DESREF($B$3;COINCIDIR(C$2;$B$4:$B$7;0);1;1;8);2*FILAS($B$4:$B5)-1)
matricialmente ejecutada.

Pero he preferido quedarme con la fórmula descrita por ser más restrictiva y quedarnos únicamente con los valores que respondían a las compras...

jueves, 4 de enero de 2018

Marcar coincidencias con formato condicional

Resolveremos hoy un problema de búsqueda de coincidencias múltiples empleando el formato condicional.
La meta del problema de hoy es marcar con algún formato los nombres coincidentes de un listado con una segunda tabla:

Marcar coincidencias con formato condicional



Como se ve en la imagen, en nuestro listado situado en A2:B23, se marcan con un formato establecido aquellos nombres que aparecen en la tabla situada en G1:G3.
Para facilitar el trabajo, la tabla de G1:G3 la hemos renombrado como 'TblNombres', a la cual, ademas le hemos asignado un nombre definido, que responde a:
nombres =TblNombres[Nombres]


Llega el momento de configurar nuestro formato condicional.
Desde la ficha Inicio > grupo Estilos > botón Formato condicional > Nueva regla > Utilice una fórmula que determine las celdas para aplicar un formato, asegurándonos que la celda activa es A2, insertaremos la siguiente fórmula:
=NO(ESERROR(BUSCARV($A2;nombres;1;0)))

y a continuación le daremos algún formato...

Marcar coincidencias con formato condicional



Conseguimos lo esperado... tenemos marcado con algún formato todas aquellas coincidencias con nuestro listado de nombres buscados...

Algo similar aplicando una macro, donde usamos el método .Find sería:

Sub Coincidencia()
'recorremos cada nombre buscado en la tabla
For Each nombre In Range("nombres")
    'buscamos coincidencias en el rango A2:A23
    With Range("A2:A23")
    'localizamos el nombre buscado
    'exigimos la coincidencia en toda la celda...
    Set c = .Find(nombre.Value, LookIn:=xlValues, LookAt:=xlWhole)
    If Not c Is Nothing Then
        firstAddress = c.Address
        Do
            'si ha habido coincidencia
            'cambiamos el color de las celdas
            Range(c, c.Offset(0, 1)).Interior.Color = vbYellow
            Set c = .FindNext(c)
        Loop While Not c Is Nothing And c.Address <> firstAddress
    End If
    End With
Next nombre
End Sub

martes, 2 de enero de 2018

VBA: Recorrer todos los gráficos modificando autoescala y otros

Recientemente, explicando en una formación de VB, surgió la cuestión de recorrer todos los gráficos de una hoja y modificar ciertas propiedades de estos, con el fin de homogeneizar los gráficos dispuestos...
Evidentemente podríamos ir uno a uno manualmente.. pero ¿y si fueran 70 gráficos?.

Veamos nuestros gráficos de partida, donde comprobamos que cada uno tiene unas dimensiones diferentes, así como (en base a estas dimensiones) las unidades del escalado de las etiquetas del eje vertical (de valores) son distintas en unos y otros.

VBA: Recorrer todos los gráficos modificando autoescala y otros



En el post de hoy daremos una posible solución, donde con una sencilla macro recorreremos todos los gráficos de la hoja activa y personalizaremos:
1-las unidades menor/mayor del autoescalado de las etiquetas del eje vertical
2-tamaño (alto+ancho) del gráfico.


Así pues añadimos la siguiente macro dentro de un módulo estándar de nuestro proyecto de VB:

Sub RecorrerGraficos()
Dim grafico As ChartObject

Application.ScreenUpdating = False
Application.EnableEvents = False

'y para recorrer todos los gráficos de la hoja...
For Each grafico In ActiveSheet.ChartObjects
    'activamos el gráfico sobre el que trabajar
    grafico.Activate
    With ActiveChart
      'modificamos las unidades del autoescalado
      With .Axes(xlValue)
          .MinorUnit = 1000
          .MajorUnit = 1000
      End With
      'y lsa dimensiones del gráfico
      With .ChartArea
          .Height = 115
          .Width = 200
      End With
    End With
Next grafico

Application.ScreenUpdating = True
Application.EnableEvents = True
End Sub



Tras ejecutar nuestra macro veremos:

VBA: Recorrer todos los gráficos modificando autoescala y otros


Comprobando como el tamaño de cada gráfico es exactamente igual, y como las unidades de la escala del eje vertical es en todos los casos de 1.000... como indicamos en la macro.