¿Cómo hacer una macro en VBA donde te cuente datos repetidos, con un rango grande?
Tengo como 3000 datos de los cuales más de 2000 se repiten; quiero elaborar una macro que me cuente los datos únicos repetidos y los guarde en una matriz. ¡Si alguien puede ayudarme se lo agradecería demasiado!
1 Respuesta
Una matriz es un contenedor de memoria donde se almacena temporalmente un grupo de datos y cuando la macro termine de ejecutarse esos datos se pierden, las matrices son muy efectivas para hacer un sinnúmero de operaciones y eficientar la macro el único detalle con ellas es que necesitan un espacio donde descargar la información así que basado en esto hice la macro al revés, esta macro lee la información de la columna A no importa si tiene un solo dato o millones y en la columna C te pondrá los datos únicos, mandando un mensaje que te dirá cuantos registros únicos hay después los va a cargar en una matriz que se llama valga la redundancia matriz y si quieres borrar la columna C entonces quítale la coma flotante a la instrucción que sigue después de la línea donde esta la palabra matriz.
Sub contar_duplicados()
Set datos = Range("a1").CurrentRegion
With datos
filas = .Rows.Count: columnas = .Columns.Count
.Columns(1).Copy
With .Columns(columnas + 2).Resize(filas, 1)
.PasteSpecial xlValues
.RemoveDuplicates Columns:=1
.Name = "registros_unicos"
End With
cuenta = WorksheetFunction.Count([registros_unicos])
MsgBox ("hay " & cuenta & " registros unicos "), vbInformation, "AVISO"
matriz = [registros_unicos]
'[registros_unicos].ClearContents
End With
Set datos = Nothing
End Sub
Hola! muchas gracias por contestar.
verás, esque mis datos están en la columna C y son datos de tipo String, por ejemplo:
AATREX
AGRAL
AGRAL
AGRAL
AGRHOL
AGRHOL
AMBER
AMBER
AMBER
AMBER
Lo que quiero realizar es una macro que guarde en una matriz lo siguiente:
AATREX 1
AGRAL 3
AGRHOL 2
AMBER 4
en dos columnas distintas. Te lo agradezco.
Entonces buscas algo así
esta es la macro que ocupas
Sub eliminar_y_contar_repetidos()
Set datos = Range("c1").CurrentRegion
With datos
filas = .Rows.Count: columnas = .Columns.Count
Set destino = .Columns(columnas + 2).Resize(filas, 1)
.Copy
End With
With destino
.PasteSpecial xlValues
.Sort key1:=Range(.Columns(columnas).Address), order1:=xlAscending
.RemoveDuplicates Columns:=1
Set destino = .CurrentRegion
filas = .Rows.Count: columnas = .Columns.Count
For i = 1 To filas
texto = .Cells(i, 1)
.Cells(i, 2) = WorksheetFunction.CountIf(datos.Columns(1), texto)
Next i
.CurrentRegion.EntireColumn.AutoFit
End With
End Sub
Me marca un error en la línea
.Sort key1:=Range(.Columns(columnas).Address), order1:=xlAscending
Ya intenté corregirlo pero sólo lo empeoro :(

y me tiene que quedar algo así, para eso quiero la matriz

Entonces prueba con esta macro, este es el resultado

Sub RESUMIR_DATOS()
Set datos = Range("A1").CurrentRegion
With datos
F = .Rows.Count: C = .Columns.Count
Set destino = .Columns(C + 3).Resize(F, 2)
Union(.Columns(2), .Columns(3)).Copy
End With
With destino
.PasteSpecial xlValues
.EntireColumn.AutoFit
.RemoveDuplicates Columns:=Array(1, 2), Header:=xlYes
Set destino = .CurrentRegion
F = .Rows.Count
For I = 2 To F
DESC = .Cells(I, 2)
With WorksheetFunction
SUMA = .SumIf(datos.Columns(3), DESC, datos.Columns(C))
PROMEDIO = .AverageIf(datos.Columns(3), DESC, datos.Columns(C))
End With
.Cells(I, 3) = SUMA: .Cells(I, 4) = PROMEDIO
Next I
.Cells(1, 3) = "TOTAL": .Cells(1, 4) = "PROMEDIO"
Union(.Columns(3), .Columns(4)).NumberFormat = "$0,0.00"
.Rows(1).Font.Bold = True
.CurrentRegion.EntireColumn.AutoFit
End With
Set datos = Nothing: Set destino = Nothing
End Sub
Sí, funciona muy bien.
Una última duda, los datos IPROD, IDESC, TOTAL Y PROMEDIO los tengo que ubicar en la segunda hoja llamada "Resultados" de la columna A a la D, cómo puedo modificar el código?
Y la lista de datos está en la hoja llamada "Existencias" así que tengo que fijar la hoja para que al correr el código tome los datos de ahí.
Esta macro toma los datos de la hoja existencia y hace un resumen de ellos en la hoja resultados
Sub HACER_RESUMEN()
Set H1 = Worksheets("EXISTENCIAS").Range("A1").CurrentRegion
With H1
F = .Rows.Count: C = .Columns.Count
Set H2 = Worksheets("RESULTADOS").Range("A1").Resize(F, 2)
Union(.Columns(2), .Columns(3)).Copy
End With
With H2
.PasteSpecial xlValues
.EntireColumn.AutoFit
.RemoveDuplicates Columns:=2
Set H2 = .CurrentRegion: F = .Rows.Count
For I = 2 To F
DESCR = .Cells(I, 2)
SUMA = WorksheetFunction.SumIf(H1.Columns(3), DESCR, H1.Columns(C))
PROMEDIO = WorksheetFunction.AverageIf(H1.Columns(3), DESCR, H1.Columns(C))
.Cells(I, 3) = SUMA: .Cells(I, 4) = PROMEDIO
Next I
Union(.Columns(3), .Columns(4)).NumberFormat = "$0,00.00"
.Cells(1, 3) = "TOTAL": .Cells(1, 4) = "PROMEDIO"
.Rows(1).Font.Bold = True
End With
Set H1 = Nothing: Set H2 = Nothing
End Sub
- Compartir respuesta