请教大家这个咋么实现？先谢谢了！

如果想在sheet1每录一行,在sheet2自动产生结果.可以用vba
右击sheet1工作表标签,查看代码,粘贴下面代码
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Column <> 2 Then Exit Sub
Set dic = CreateObject("scripting.dictionary")
arr = Range("A1").CurrentRegion.Value
For r = 1 To UBound(arr)
dic(arr(r, 1)) = dic(arr(r, 1)) & "," & arr(r, 2)
Next
k = dic.keys
d = dic.items
Set dic = Nothing
r = UBound(k)
ReDim a(r, 0)
ReDim b(r, 0)
For i = 0 To UBound(k)
a(i, 0) = k(i)
b(i, 0) = Mid(d(i), 2)
Next
r = r + 1
With Sheets("sheet2")
.Range("A1").Resize(r) = a
.Range("b1").Resize(r) = b
End With
End Sub

b列不重复.同样是用字典去重.
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Column <> 2 Then Exit Sub
Set dic = CreateObject("scripting.dictionary")
arr = Range("A1").CurrentRegion.Value
For r = 1 To UBound(arr)
dic(arr(r, 1)) = dic(arr(r, 1)) & "," & arr(r, 2)
Next
k = dic.keys
d = dic.items
r = UBound(k)
ReDim a(r, 0)
ReDim b(r, 0)
For i = 0 To UBound(k)
dic.RemoveAll
a(i, 0) = k(i)
c = Split(d(i), ",")
For j = 1 To UBound(c)
dic(c(j)) = 0
Next
c = dic.keys
b(i, 0) = Join(c, ",")
Next
Set dic = Nothing
r = r + 1
With Sheets("sheet2")
.Range("A1").Resize(r) = a
.Range("b1").Resize(r) = b
End With
End Sub