从列中获取唯一值

Question

手头的任务是在 A 列中搜索，看看我有什么值（它们以字母的形式），然后粘贴每个唯一的条目，将其值粘贴到另一列中。

这是一个直观的解释：

我想到的是创建一个 For 循环，该循环通过 A 列启动并创建一个条件，如果它找到某个值，那么它将将该值插入该范围内。这是代码：

For i = 1 to 26

if cells(i,26).value= "A" Then

Range ("C1")= "A"

Elseif cells(i,26).value = "B" then
Range ("C2").value = "B"
ElseIf (i,26).value = "C" then 
Range ("C3").value = "C"
EndIf
Next i
end sub 

我想缩短这个过程，因为我的数据集非常大，有很多公司名称。有什么建议吗？我相信必须有一种方法可以了解这些价值观，而不必自己查看所有价值观。

Answer 1

如果目标只是获取

Column A

输出到

Column C

中找到的唯一值列表，您可以使用以下宏。这实际上只是重新创建手动查找唯一值的一种方法的步骤。不是最复杂的解决方案，但它有效

1. 使用公司名称创建列的副本（使用工作表中最后一个可用列）
2. 删除辅助列的重复数据
3. 将重复数据删除的列复制到目标
4. 删除辅助列

假设工作表上的最后一列未被使用

---

Sub Unique()

Dim ws As Worksheet: Set ws = ThisWorkbook.Sheets("Sheet1")
Dim lr As Long, lc As Long

'Determine Range Size
lr = ws.Range("A" & ws.Rows.Count).End(xlUp).Row
lc = ws.Cells(1, ws.Columns.Count).Column

'Copy Company Names To Helper Column/Remove Duplicates
ws.Range("A2:A" & lr).Copy ws.Cells(1, lc)
ws.Columns(lc).RemoveDuplicates Columns:=1, Header:=xlNo
lr = ws.Cells(ws.Rows.Count, lc).End(xlUp).Row

'Output Unique Values From Helper Column
ws.Range(ws.Cells(1, lc), ws.Cells(lr, lc)).Copy
ws.Range("C2").PasteSpecial xlPasteValues

'Delete Helper Column
ws.Columns(lc).Delete

End Sub

---

注意我对帖子的评论。这里可能根本不需要VBA

Answer 2

这是使用

.RemoveDuplicates

的稍微不同的版本，它也会删除空白单元格。

您也可以在没有 VBA 的情况下完成此操作。只需将所需的列复制到另一个列，然后使用数据选项卡下的删除重复项即可。

Sub Unique_Values()

   Dim ws As Worksheet: Set ws = ThisWorkbook.Sheets("Sheet1")
   
    'Getting all the values in column A (except header)
    'Copying them into cell C2 and below
    ws.Range("A2", Range("A1048576").End(xlUp)).Copy Range("C2")
    
    'setting the header for the column C
    ws.Range("C1").Value = "What companies are in Column A?"
    
    'Removing duplicates and blanks from column C
    With ws.Range("$C$2", Range("C1048576").End(xlUp))
        .Value = .Value
        .RemoveDuplicates Columns:=1, Header:=xlNo
        On Error Resume Next
        .SpecialCells(xlCellTypeBlanks).Delete xlShiftUp
       On Error GoTo 0
    End With

End Sub

虽然我同意其他答案中使用的编码约定，但我认为问题有点过于复杂，会给初学者带来困惑。

Answer 3

我认为到目前为止的两个答案都会给你你想要的，也许还可以进一步简化？

Sub GetUniqueQuick()
Dim LastRow As Long
Application.ScreenUpdating = False  
LastRow = Sheets("Sheet1").Cells(Rows.Count, 1).End(xlUp).Row

Sheets("Sheet1").Range("A2:A" & LastRow).Copy Sheets("Sheet1").Range("C2")    
Sheets("Sheet1").Range("C1:C" & LastRow).RemoveDuplicates Columns:=1, Header:=xlYes

End Sub

Answer 4

使用 MS 365 的动态功能，您可以简单地在给定范围内应用 工作表功能

UNIQUE()

，例如

= UNIQUE(A2:A100)

或将其集成到用户定义的函数中

Function GetCompanies(rng As Range)
    If rng.Columns.Count > 1 Then Exit Function    ' allow only one column
    GetCompanies = Application.Unique(rng)         ' return function result as 2-dim array
End Function

由于空单元格会产生具有

0

输出的伪唯一值，因此您可以在公式中使用添加的装饰性空白字符串来调用它们：

=GetCompanies(A2:A100)&""

Answer 5

在某些情况下，基于公式的解决方案可能是负担得起的，所以我将在这里提供这种解决方案：

1. 在单元格 B2 中插入：

   =IF(IFERROR(MATCH(A2,A$1:A1,0),"k")="k", 1,0)

   然后将其扩展到最后一个单元格（名为 B26）
2. 在单元格 C2 中输入：

   =IF(B2=1,SUM(B$1:B2),"")

   ，同样的扩展 之前。
3. 在单元格 D2 中：

   =IFERROR(INDIRECT("A" & MATCH(ROW(A1),C:C,0)),"")

   ， 这将是最终的唯一值列。