vba提取相同项生成新表

可以使用 VBA 编写代码来提取相同项并生成新表。具体实现方法可以参考以下代码：

Sub ExtractDuplicates()
Dim ws As Worksheet
Dim rng As Range
Dim dict As Object
Dim cell As Range
Dim key As Variant
Dim i As Long

Set ws = ActiveSheet
Set rng = ws.Range("A1:A" & ws.Cells(ws.Rows.Count, "A").End(xlUp).Row)
Set dict = CreateObject("Scripting.Dictionary")

For Each cell In rng
If Not dict.exists(cell.Value) Then
dict.Add cell.Value, 1
Else
dict(cell.Value) = dict(cell.Value) + 1
End If
Next cell

If dict.Count > Then
Set ws = Worksheets.Add
ws.Name = "Duplicates"
ws.Range("A1").Value = "Value"
ws.Range("B1").Value = "Count"
i = 2
For Each key In dict.keys
ws.Range("A" & i).Value = key
ws.Range("B" & i).Value = dict(key)
i = i + 1
Next key
End If
End Sub

这段代码会在当前工作表中提取 A 列中的相同项，并生成一个新的工作表，名为 "Duplicates"，其中包含两列数据，第一列为相同项的值，第二列为该值出现的次数。