EXTRAER DATOS DE UNA CELDA Y COLOCARLOS EN DIAGONAL

Hola a todos : )

Este fin de semana he tenido que resolver dos consultas bastante complicadas que me enviaron unos lectores y no tuve tiempo para subir el post que había preparado. Pero hoy ya puedo hacerlo : )

La entrada de hoy se basa en una consulta que me enviaron hace unas semanas, aunque se trata de una tarea sencilla, realmente no sé cual es el destino o función para la que se necesita. En la petición se solicitaba una macro que extrajera el contenido de una celda (letras o números) y que colocase los datos en diagonal.

Intuyo que se trata de algo para generar claves o correspondencias, pero bueno … yo me he limitado a enviar el código según sus especificaciones.

Imaginad estos datos:

EXTRAER DATOS DE UNA CELDA Y COLOCARLOS EN DIAGONAL

y ahora tenemos que colocar cada letra o número de la palabra en diagonal, ¿cómo lo hacemos?, pues con esta macro:

Sub PASAR_A_DIAGONAL()
'Declaramos variables
Dim i As Long, j As Long
Dim fin As Long, n As Long
'Desactivamos actualización de pantalla
Application.ScreenUpdating = False
With Sheets("Hoja1")
'Eliminamos datos anteriores
If .Range("B2").Value <> vbNullString Then
.Range("B2", ActiveCell.SpecialCells(xlLastCell)).Select
Selection.ClearContents
End If
'Iniciamos loop que recorra todas las celdas
fin = Application.CountA(.Range("A:A"))
For i = 2 To fin
miCelda = .Cells(i, 1)
n = Application.CountA(.Range("B:B")) + 2
'Iniciamos loop que recorra toda la palabra
'y colocamos números o letras en diagonal
For j = 1 To Len(miCelda) Step 1
Letra = Mid(miCelda, j, 1)
.Cells(n, j + 1) = Letra
.Cells(n, j + 1).HorizontalAlignment = xlRight
n = n + 1
Next j
n = 0
Next i
.Range("A1").Select
Application.ScreenUpdating = True
End With
End Sub

Como podéis observar, básicamente utilizamos dos loop para localizar y extraer los datos. Luego solo tenemos que utilizar las variables creadas para indicar el lugar (horizontal y vertical) en que se debemos mostrar la información.

El resultado de aplicar la macro es este:

EXTRAER DATOS DE UNA CELDA Y COLOCARLOS EN DIAGONAL1

Efectivamente, los datos se han ordenado en diagonal, tanto las letras como los números. Sin duda una petición curiosa : )

Y esto ha sido todo por hoy, espero que os resulte interesante.

Descarga el archivo de ejemplo pulsando en: EXTRAER DATOS DE UNA CELDA Y COLOCARLOS EN DIAGONAL

 

 

¿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

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