[英]Getting unique values from a column
手头的任务是在 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
我想缩短这个过程,因为我的数据集非常大,有很多公司名称。 有什么建议吗? 我相信必须有一种方法来了解这些价值观,而不必自己查看所有价值观。
如果目标只是获取在Column A
Column C
列中找到的唯一值列表,则可以使用以下宏。 这实际上只是重新创建您手动查找唯一值的一种方法的步骤。 不是最复杂的解决方案,但它有效
假设未使用工作表上的最后一列
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 这里可能根本不需要
这是使用.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
尽管我同意另一个答案中使用的编码约定,但我认为这会使问题过于复杂,这会使初学者感到困惑。
我认为到目前为止,这两个答案都会给你你想要的,也许可以进一步简化?
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
使用 MS 365 的动态功能,您可以简单地在给定范围内应用工作表 function UNIQUE()
,例如
= UNIQUE(A2:A100)
或将其集成到用户定义的 function
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
output 的伪唯一性,因此您可以在公式中调用它们并添加装饰性空白字符串:
=GetCompanies(A2:A100)&""
声明:本站的技术帖子网页,遵循CC BY-SA 4.0协议,如果您需要转载,请注明本站网址或者原文地址。任何问题请咨询:yoyou2525@163.com.