【问题标题】:Unique values and CSV column唯一值和 CSV 列
【发布时间】:2015-09-19 13:57:37
【问题描述】:

我想从 Excel 中的 A 列和 B 列中获取唯一值。所以转换这个:

进入那个:

在 Excel 中可以吗?

【问题讨论】:

标签: excel vba


【解决方案1】:

Sheet1 中有这样的数据:

运行这个宏:

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 中生成:

注意:

Sheet1中的数据不需要排序。

【讨论】:

  • @Sam 感谢您的反馈!
【解决方案2】:

试试这个:

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

【讨论】:

    【解决方案3】:

    这就是你所需要的,不需要任何东西排序:

    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
    

    这段代码非常快。如果您要处理大型列表,这里的效率将不胜感激。

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

    【讨论】:

      【解决方案4】:

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

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

      通过过滤 value = 1 的 finalList 列,我们得到了想要的结果:

      所需公式如下:

      单元格 C1 : =B2

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

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

      注意:这仅在 A 列已排序时有效。

      【讨论】:

        猜你喜欢
        • 1970-01-01
        • 2018-08-20
        • 2019-02-18
        • 2023-04-03
        • 1970-01-01
        • 2020-01-15
        • 1970-01-01
        • 2015-03-15
        • 2016-10-07
        相关资源
        最近更新 更多