识别位置数，然后输出另一列中的位置和数字

Question

大家好，我是VBA和StackOverflow的新手。目前，我正在尝试使用VBA创建一个过程来总结我收集的数据。上面的照片是我面临问题的长宏过程的一部分。我需要在＃34; A＆＃34;列中找到唯一位置的数量。 （可以随时间添加新位置），然后将唯一位置输出到列＃34; J＆＃34;中的位置列。在那之后，在＆＃34; K＆＃34;栏中，我需要计算每个唯一等级的数量。

截至目前，我有以下代码可以找到一个职位。

Sub test ()
Dim Manager as Integer
Sheets("Sheet1").Select
Manager = Application.WorksheetFunction.CountIf(Range("A:A"), "Manager")
'Output the Manager value anywhere as require
End Sub

然而，我在识别独特位置，计算独特位置，然后输出位置旁边的唯一位置数量方面面临挑战。这甚至可以在VBA中使用吗？

非常感谢

Answer 1

我觉得你可能会过度复杂化并要求VBA，因为你可能不知道没有VBA就可以完成任务。据我所知，您需要计算A列中每个位置的计数。可以使用数据透视表轻松完成，而无需使用VBA重新发明轮子。数据透视表比传统公式更强大，速度更快，并且比您提出的任何VBA都要快得多。

考虑一下这个截图：

我已将列A转换为Excel表格对象，其中包含Insert＆gt;表（或Ctrl-T），因此数据可以轻松增长，但这是可选的。

然后我插入了一个数据透视表并将位置拉到行区域并再次将其拉到值区域，在该区域中聚合了一个计数。

没有公式，没有VBA。

如果这不是您所需要的，请编辑您的问题并澄清。否则，请随意将此标记为答案。

Answer 2

首先创建“Temp”表，然后在下面执行此VBA：

    Sub ExtractUnique()
    Dim sh As Worksheet
    Dim shTemp As Worksheet
    Dim LastRow As Long

    Set sh = ActiveSheet 'or change to your sheet name Sheets("your sheet")
    LastRow = sh.Cells(sh.Rows.Count, "A").End(xlUp).Row

   'temporary sheet
   Set shTemp = ThisWorkbook.Sheets("Temp") 'MAKE SURE YOU CREATE 'Temp' sheet first!!!

   'copy your positions to temporary sheet for manipulation
   sh.Range("A1:A" & LastRow).Copy
   shTemp.Range("A1").PasteSpecial xlValues
   Application.CutCopyMode = False

   'remove duplicates
   shTemp.Range("A1:A" & LastRow).RemoveDuplicates Columns:=Array(1), Header:=xlYes

   'copy it back to J1 of your original sheet
   'first check the last row of unique position list
   LastRow = shTemp.Cells(sh.Rows.Count, "A").End(xlUp).Row

   shTemp.Range("A1:A" & LastRow).Copy
   sh.Range("J1").PasteSpecial xlValues
   Application.CutCopyMode = False

   'set the formula to count the number of positions
   sh.Range("K2:K" & LastRow).Formula = "=COUNTIF(A:A,J2)"

   End Sub