¿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

Respuesta
2

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 :(

Pon una pantalla de tu información para ver que esta provocando ese error

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

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas