Valores únicos de string no intervalo

Question

Eu tenho algumas planilhas onde há um grande número de células que foram essencialmente usadas para texto livre.

Existe um conjunto finito de valores para este texto livre e a maioria, se não todos, de repetição.

por exemplo.

   A        B       C       D
1  Monkey   Gorilla Cat     Dog
2  Dog      Cat     Gorilla Gorilla
3  Dog      Dog     Dog     Cat

Existem provavelmente 50 ou mais valores diferentes de células distribuídos em várias planilhas e centenas de linhas e colunas.

Eu preciso analisar esses dados e contar as ocorrências, o que não é um problema além de obter uma lista de valores únicos para começar, e isso tem me impulsionado.

Qual é a melhor maneira de produzir essa lista?

Então, acima, teríamos

Monkey
Dog
Cat
Gorilla

Em ordem de soluções preferenciais, pois isso precisará ser feito mensalmente.

1. Fórmula dinâmica baseada
2. Script VB
3. Outro (filtragem avançada ou outras etapas manuais)

Answer 1

Com base em algum código inicial encontrado aqui , esta FUNÇÃO DEFINIDA PELO USUÁRIO coletará todos os valores de todas as células em todas as outras folhas que não aquela em que você usa esta função. Portanto, seja claro, insira uma folha em branco em sua pasta de trabalho e use essa função somente nessa folha.

= UNIQUE (ROW (A1))

Coloque essa fórmula em qualquer célula e, em seguida, copie até que não apareçam mais valores.

Na mesma pasta de trabalho, coloque este código UDF em um módulo em branco (Módulo Insert >):

    Option Explicit

    Function UNIQUE(ItemNo As Long) As Variant
    Dim cl As Range, cUnique As New Collection, cValue As Variant
    Dim ws As Worksheet, Inputrange As Range
    Application.Volatile

    On Error Resume Next
    For Each ws In ThisWorkbook.Worksheets
        If ws.Name <> Application.Caller.Parent.Name Then
            For Each cl In ws.UsedRange
                If cl.Formula <> "" Then cUnique.Add cl.Value, CStr(cl.Value)
            Next cl
        End If
    Next ws
    On Error GoTo 0

    UNIQUE = ""
    If ItemNo = 0 Then
        UNIQUE = cUnique.Count
    ElseIf ItemNo <= cUnique.Count Then
        UNIQUE = cUnique(ItemNo)
    End If

    End Function

    

Answer 2

Supondo que os dados sejam pequenos o suficiente para caber em uma coluna em uma planilha, eu copiaria todas as colunas em uma coluna e criaria uma tabela dinâmica simples para contar cada valor para mim.

Para executá-lo com frequência, criamos uma macro VBA, não um script VB. O procedimento abaixo fará a coisa toda automaticamente no Excel 2010. (Alguns dos códigos da tabela dinâmica podem ser diferentes em versões anteriores do Excel).

Sub CreateSummary()
' This macro assumes there is nothing else below the data being summarized
' and that there are no empty cells in any of the columns of data.
   Const FIELDNAME As String = "FreeText"
   Dim v As Variant
   Dim sht As Worksheet, rTop As Range, r As Range
   Dim pc As PivotCache, pt As PivotTable

   Set v = Application.InputBox("Select first cell of table to be summarized." _
                               , "Create Summary", Type:=8)
   If TypeName(v) = "Range" Then
      Set rTop = v
   Else
      Exit Sub
   End If
   Set sht = rTop.Parent

   ' create new summary worksheet
   sht.Copy
   ActiveSheet.Name = sht.Name & " Summary"
   Set sht = ActiveSheet
   Set rTop = sht.Range(rTop.Address)

   ' add header
   rTop.Rows.EntireRow.Insert
   With rTop.Offset(-1)
      .Value = FIELDNAME
      .Font.Bold = True
      .BorderAround XlLineStyle.xlContinuous
   End With

   ' Grab data from other columns and move it to first column
   Application.ScreenUpdating = False
   Application.StatusBar = "Converting table to one column ..."
   Set r = rTop.Offset(0, 1)
   Do While r.Value <> ""
      sht.Range(r, r.SpecialCells(xlCellTypeLastCell)).Cut
      rTop.End(xlDown).Offset(1).Select
      sht.Paste
      Set r = r.Offset(0, 1)
      Application.StatusBar = Application.StatusBar & "."
      DoEvents
   Loop
   rTop.Select
   Application.ScreenUpdating = True

   ' create PivotTable
   Application.ScreenUpdating = False
   Application.StatusBar = "Creating pivot table..."
   Set r = Range(rTop.Offset(-1), rTop.End(xlDown))
   With ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:=r.Address)
      With .CreatePivotTable(TableDestination:=rTop.Offset(-1, 2))
         .AddDataField .PivotFields(FIELDNAME), "Count", xlCount
         .AddFields FIELDNAME, , , True
      End With
   End With
   Application.ScreenUpdating = True
   Application.StatusBar = False

   Set r = Nothing
   Set rTop = Nothing
   Set sht = Nothing

   MsgBox "Done creating summary."
End Sub