VBA para extraer datos no repetidos de varios rangos
Buenas noches, de nuevo yo con mis macros extrañas :)
Solicito que me colaboren con esta macro, los datos allí en la imagen son a manera de ejemplo ya que lo voy a emplear en otra tabla con datos mucho más grandes, pero si funciona aqu, ya modifcando los rangos y demás datos funcionaria donde la necesito, ahora si al grano.
Necesito básicamente que la macro lea los datos que están en esos 4 rangos y los números que NO están repetidos los pegue a partir de la columna AD, en este caso serian los números "004" "007" "008" "011" "015", resalto que los rangos en la macro deben ir por separados, y poderlos después reemplazar, osea (rango 1 "A:E") ( rango 2 "H:L") (rango 3 "O:S") rango4 "(V:Z") informo que los datos de la tabla están en formato texto y como ven hay algunas celdas vacías también. No siempre están los rangos totalmente llenos de datos y seria que se ejecute en la fila donde estoy activo.
POR ULTIMO Y MUY IMPORTANTE: que la macro funcione en segundo plano en otra hoja, ejemplo "hoja2" pero yo estoy activo en hoja1, pero todos los datos a leer de la macro están en esa hoja2
Observa como puse los rangos empezando en la fila 2, terminan en la última fila con datos de la hoja1.
Por supuesto, puedes ejecutar la macro en cualquier otra hoja.
Sub Extraer_No_Repetidos()
Dim sh As Worksheet
Dim dic As Object, ky As Variant, rangos As Variant
Dim r As Range, c As Range
Dim i As Long, lr As Long
'
Set dic = CreateObject("Scripting.Dictionary")
Set sh = Sheets("Hoja1")
lr = sh.UsedRange.Rows(sh.UsedRange.Rows.Count).Row
rangos = Array("A2:E" & lr, "H2:L" & lr, "O2:S" & lr, "V2:Z" & lr)
'
For i = 0 To UBound(rangos)
Set r = sh.Range(rangos(i))
For Each c In r.SpecialCells(xlCellTypeConstants)
dic(c.Value) = dic(c.Value) + 1
Next
Next
'
i = 2
For Each ky In dic.keys
If dic(ky) = 1 Then
sh.Range("AD" & i).Value = ky
i = i + 1
End If
Next
End SubSi tienes más de 100,000 datos, entonces habría que hacer cambios para hacerla más rápida. Pero me comentas el desempeño.
Dante muchas gracias por tomarte el trabajo de ayudarme.
Te cuento que la macro hace el trabajo necesitado, que es sacar los números no repetidos de los 4 rangos...
Pero al pegar los resultados los hace hacia abajo. Osea hacia abajo sobre una misma columna y necesitaría que lo hiciera una seguida de otra pero en forma de filas así como están los datos.
También otro cambio seria que lo hiciera de acuerdo a la fila donde yo este activo "osea, si estoy en la fila "2", ejecute solo los datos de la fila "2". y no toda la tabla como creo que esta la macro diseñada.
De resto parece que hace perfecto su trabajo :)
Pero al pegar los resultados los hace hacia abajo. Osea hacia abajo sobre una misma columna y necesitaría que lo hiciera una seguida de otra pero en forma de filas así como están los datos.
Sería conveniente que lo menciones y pongas ejemplos de cómo quieres el resultado.
También otro cambio seria que lo hiciera de acuerdo a la fila donde yo este activo
.
Que la macro funcione en segundo plano en otra hoja
R ecuerda que vas a estar en otra hoja, entonces, si estás en la fila 5 de la otra hoja, ¿quieres qué trabaje en la hoja1 en la fila 5?
osea (rango 1 "A:E") ( rango 2 "H:L") (rango 3 "O:S") rango4 "(V:Z")
También otro cambio seria que lo hiciera de acuerdo a la fila donde yo este activo
Tus rangos de ejemplo se refieren a toda la columna. También es conveniente que si quieres que trabaje en una fila, lo menciones en tu petición original.
Sería conveniente que lo menciones y pongas ejemplos de cómo quieres el resultado.
Tienes razón.. es que aveces son tantos detalles que se me pasan.. :)
R ecuerda que vas a estar en otra hoja, entonces, si estás en la fila 5 de la otra hoja, ¿quieres qué trabaje en la hoja1 en la fila 5?
Exacto. Todos los datos de rango también están en la hoja1, simplemente que yo estoy activo en otra hoja, y que si estoy en la fila5, entonces la macro trabaje en la hoja1 los datos de la fila5.
Tus rangos de ejemplo se refieren a toda la columna. También es conveniente que si quieres que trabaje en una fila, lo menciones en tu petición original.
Si tienes razón :/ los datos de los rangos los coloque como columna. Si no que no le coloque fila porque pues trabajaría de acuerdo a la fila donde estoy activo y no sabia como colocarlo en el rango. Pero creo que en alguna parte dije que trabajara de acuerdo a la fila donde estuviera activo. :P.. Igual allí le vamos dando forma.
Muchas gracias por todos los aportes. :)
Tienes razón.. es que aveces son tantos detalles que se me pasan.. :)
Si los detalles se te pasan a ti, no podremos adivinar exactamente qué necesitas, r ecuerda tú estás pidiendo ayuda, entonces procura poner todos los detalles, de esa manera podrás recibir una respuesta más completa.
Si estoy en la fila5, entonces la macro trabaje en la hoja1 los datos de la fila5.
Prueba la siguiente:
Sub Extraer_No_Repetidos()
Dim sh As Worksheet, dic As Object, ky As Variant, rangos As Variant
Dim c As Range, i As Long, lr As Long
'ENTRADA
Set dic = CreateObject("Scripting.Dictionary")
Set sh = Sheets("Hoja1")
lr = ActiveCell.Row
rangos = Array("A" & lr & ":E" & lr, "H" & lr & ":L" & lr, "O" & lr & ":S" & lr, "V" & lr & ":Z" & lr)
'PROCESO
For i = 0 To UBound(rangos)
For Each c In sh.Range(rangos(i))
If c.Value <> "" Then dic(c.Value) = dic(c.Value) + 1
Next
Next
'SALIDA
i = Columns("AD").Column
For Each ky In dic.keys
If dic(ky) = 1 Then
sh.Cells(lr, i).Value = ky
i = i + 1
End If
Next
End Sub
¡Gracias! Me funciono de maravilla, disculpa los inconvenientes, para las próximas enumerare los detalles..
Necesitare más tarde hacer una macro igual a esta. Con la diferencia en vez de extraer los no repetidos, saque los que estén repetidos 2 veces, 3 veces y 4 veces. Pero abriré otra pregunta si es necesario por cada una.
Mil gracias y disculpa el inconveniente. :)
Me alegra ayudarte G racias! Por comentar.
