Уникальные строковые значения в диапазоне

Question

У меня есть несколько таблиц, где есть большое количество ячеек, которые по существу были использованы для свободного текста.

Для этого свободного текста существует конечный набор значений, и большинство, если не все, повторяются.

например.

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

Вероятно, существует около 50 различных значений ячеек, распределенных по нескольким листам и сотням строк и столбцов.

Мне нужно проанализировать эти данные и посчитать количество совпадений, что не является проблемой, кроме как получить список уникальных значений, с которого я начал, и это привело меня к успеху.

Каков наилучший способ составить этот список.

Так что из вышесказанного мы бы

Monkey
Dog
Cat
Gorilla

В порядке предпочтительных решений, так как это нужно будет делать ежемесячно.

1. Динамическая формула на основе
2. VB Script
3. Другое (расширенная фильтрация или другие ручные действия)

Answer 1

На основании некоторого начального кода, найденного здесь, эта ОПРЕДЕЛЕННАЯ ФУНКЦИЯ ПОЛЬЗОВАТЕЛЯ будет собирать все значения из всех ячеек на всех ДРУГИХ листах, кроме той, на которой вы используете эту функцию. Поэтому будьте осторожны, вставьте чистый лист в свою книгу и используйте эту функцию только на этом листе.

= Unique (СТРОКА (А1))

Поместите эту формулу в любую ячейку, затем копируйте вниз, пока значения больше не появятся.

В той же книге поместите этот код UDF в пустой модуль (Вставка> Модуль):

    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

Предполагая, что данные достаточно малы, чтобы поместиться в один столбец на рабочем листе, я бы скопировал все столбцы в один столбец и создал бы простую сводную таблицу для подсчета каждого значения для меня.

Чтобы запустить его часто, я бы создал макрос VBA, а не скрипт VB. Приведенная ниже процедура сделает все это автоматически в Excel 2010. (Некоторый код сводной таблицы может отличаться в более ранних версиях 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