☰

范围内的唯一字符串值

tag-icon • tag-icon microsoft-excel spreadsheet
范围内的唯一字符串值

我有一些电子表格，其中有大量单元格基本上被用作自由文本。

此自由文本具有有限的值集，并且大多数（如果不是全部）都会重复。

例如。

   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 脚本
  3. 其他（高级过滤或其他手动步骤）

答案1

基于一些起始代码找到这里，此用户定义函数将收集除使用此函数的工作表之外的所有其他工作表上的所有单元格的所有值。因此，请明确说明，在您的工作簿中插入一张空白工作表，并仅在该工作表上使用此函数。

=唯一（行（A1））

将该公式放入任意单元格中，然后向下复制，直到不再出现任何值。

在同一个工作簿中，将此 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

答案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

相关内容