
¿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
