唯一值和CSV列

时间:2015-09-19 13:57:38

标签: excel vba

我想从A列中获取唯一值,并在excel中获取B列中的所有相应值。所以改变这个:

Image 1

进入那个:

Image 2

可以在Excel中使用吗?

4 个答案:

答案 0 :(得分:1)

使用 Sheet1 中的数据:

enter image description here

运行此宏:

Sub dural()
   Dim s1 As Worksheet, s2 As Worksheet
   Dim i As Long, j As Long, st As String
   Set s1 = Sheets("Sheet1")
   Set s2 = Sheets("Sheet2")
   s1.Range("A:A").Copy s2.Range("A1")
   s2.Range("A:A").RemoveDuplicates Columns:=1, Header:=xlNo

   For Each r In s2.Range("A:A")
      v = r.Value
      If v = "" Then Exit Sub
         For Each rr In s1.Range("A:A")
            vv = rr.Value
            If vv = "" Then Exit For
            If v = vv Then
               If r.Offset(0, 1).Value = "" Then
                  r.Offset(0, 1).Value = rr.Offset(0, 1).Value
               Else
                  r.Offset(0, 1).Value = r.Offset(0, 1).Value & " ," & rr.Offset(0, 1).Value
               End If
            End If
      Next rr
   Next r
End Sub

将在 Sheet2

中生成此内容

enter image description here

注:

Sheet1 中的数据不需要排序。

答案 1 :(得分:1)

试试这个:

Sub Test()
    Dim objIds, arrData, i, strId
    Set objIds = CreateObject("Scripting.Dictionary")
    arrData = Range("A1:B8").Value ' put here your source range
    For i = LBound(arrData, 1) To UBound(arrData, 1)
        If IsEmpty(objIds(arrData(i, 1))) Then
            objIds(arrData(i, 1)) = arrData(i, 2)
        Else
            objIds(arrData(i, 1)) = objIds(arrData(i, 1)) & ", " & arrData(i, 2)
        End If
    Next
    i = 1 ' first row for output
    For Each strId In objIds
        Cells(i, 3) = strId ' first column for output
        Cells(i, 4) = objIds(strId) ' second column for output
        i = i + 1
    Next
End Sub

答案 2 :(得分:1)

这就是你所需要的,没有必要排序:

Sub Sam()
    Dim c&, i&, d$, s$, v, w
    v = [a1].CurrentRegion.Resize(, 2)
    ReDim w(1 To UBound(v), 1 To 2)
    For i = 1 To UBound(v)
        d = ", "
        If s <> v(i, 1) Then d = "": c = c + 1: s = v(i, 1): w(c, 1) = s
        w(c, 2) = w(c, 2) & d & v(i, 2)
    Next
    [d1:e1].Resize(UBound(w)) = w
End Sub

这段代码非常快。如果您要处理一个大型列表,那么效率会很高。

您可以通过调整过程顶部和底部方括号中的地址来管理源数据的位置以及输出的位置。

答案 3 :(得分:0)

看看如何使用Excel公式解决这个问题(我知道OP中有一个VBA标签),但这是另一种选择。

使用公式添加2个额外的列,我们得到此结果:

enter image description here

通过对值为1的finalList列进行过滤,我们得到了所需的结果:

enter image description here

所需的公式如下:

Cell C1:= B2

单元格C2(并向下复制到C列中的所有单元格):= IF(A3 = A2,C2&amp;&#34;,&#34;&amp; B3,B3)

单元格D1(并向下复制到D列中的所有单元格):= IF(A2 = A3,0,1)

注意:这仅适用于A列的排序。

相关问题