Este fórum está sendo desativado

[Domingsp]

Olá, gostaria de contar no intervalo de S1:V8 quantos nomes aparecem pelo menos 2 vezes. A seguir exibir os nomes em lista na col X.
Fiz esse codigo no qual ele conta e exibe em X o nome. Mas do jeito que está, como são muitos nomes, eu teria que fazer uma linha de código para cada nome: QCatia, QGeraldo, QCassia...
Procuro uma solução melhor na qual ele verifica quais nomes aparecem pelo menos 2x e lista na col X.
Anexei uma figura que mostra a matriz e a forma como quero exibir(não precisa ser em ordem alfabetica).

Código: Selecionar todos

Sub CARNAVALESCOS()
Sheets("Plan6").Activate
  QCatia = Application.CountIf(Range("S1:V8"), "Catia")
   If QCatia >= 2 Then Cells(i + 1, 24) = Catia: i = i + 1
End if

[gfranco]

Bom dia.
Veja se o que fiz te ajuda.

[Domingsp]

Vou adaptar. Obrigado

[osvaldomp]

Código: Selecionar todos

Sub ListaNomes()
 Dim n As Range
  [X:Y] = "": [X1] = "nome": [Y1] = "qtde"
  For Each n In Range("S1:V8")
   If Application.CountIf(Range("S1:V8"), n.Value) > 1 And Application.CountIf([X:X], n.Value) = 0 Then
    Cells(Rows.Count, "X").End(3)(2) = n.Value
   End If
  Next n
 Range("Y2:Y" & Cells(Rows.Count, "X").End(3).Row).Formula = "=COUNTIF(S$1:V$8,X2)"
End Sub

[juniorieq61]

Olá amigo, pelo que entendi, você quer uma lista com os nomes únicos que aparecem naquele range e ao lado a quantidade de vezes que ele se repete certo?

Segue o código aqui e a pasta de trabalho anexada.

Código: Selecionar todos

Public Sub Main()
    Dim ws          As Worksheet
    Dim lRow        As Long
    Dim lCol        As Integer
    Dim iRow        As Long
    Dim iCol        As Integer
    Dim oDic        As Object
    Dim NewItem     As String
    Dim arr         As Variant
    Dim Key         As String
    Dim wFunction   As WorksheetFunction
    
    Set wFunction = Application.WorksheetFunction
    Set oDic = CreateObject("Scripting.Dictionary")
    Set ws = Planilha1
    
    With ws
        lRow = .Cells(.Rows.Count, 1).End(xlUp).Row
        lCol = .Cells(1, .Columns.Count).End(xlToLeft).Column
        oDic.CompareMode = TextCompare
        
        For iRow = 1 To lRow
            For iCol = 1 To lCol
                NewItem = .Cells(iRow, iCol).Value2
                If Not oDic.Exists(NewItem) Then oDic.Add NewItem, NewItem
            Next iCol
        Next iRow
           
        If .Range("H3").Value = "" Or .Range("I3").Value2 = "" Then GoTo Continue

        .Range("H3", .Range("H3").End(xlDown)).ClearContents
        .Range("I3", .Range("I3").End(xlDown)).ClearContents
        
Continue:
        arr = oDic.Items
        
        For iRow = LBound(arr) To UBound(arr)
            .Cells(iRow + 3, "H").Value2 = arr(iRow)
            .Cells(iRow + 3, "I").Value2 = _
                    wFunction.CountIf(.Range("A1", .Cells(lRow, lCol)), arr(iRow))
        Next iRow
    End With
End Sub

Espero que seja isso, abraço!

[Domingsp]

Olá, Junior. Eu não precisava saber a quantidade de vezes que se repete. Só queria a lista dos nomes que aparecem pelo menos 2 vezes. Mas tudo já foi resolvido. De qualquer forma muito obrigado pela atenção.