试图找到唯一的ID，其所有的值都符合excel [英] Trying to find unique IDs with all of the values it qualifies for in excel

问题描述

说实话，我不完全确定如何描述我正在努力完成什么？但是，在这里呢我有一个excel表，其中包含一列ID，第二列值需要与第一列相关联。问题是列A中的ID包含重复项，这是可以的，因为一个ID可以符合多个值。我需要的是让第三列拉回唯一的ID，第四列拉回符合条件的所有值的分号分隔列表。希望附加的图像有意义吗？对于什么值得我尝试过我可以想到的每一个公式，我真的不知道宏，这是我正在想的需要实现的。

解决方案

这是一种替代方法，具有几个优点

• 它填充唯一的sku的列表


• 它清除列中的旧数据 C：D


• 它的运行速度要比循环越来越快

---

  Sub Demo（）
 Dim rngA As Range，rng as Range 
 Dim datA As Variant 
 Dim我As Long 
 Dim sh As Worksheet 
 Dim dic As Object 
 
 Set sh = ActiveSheet'可以将其更改为您选择的工作表
设置dic = CreateObject（ Scripting.Dictionary）
 
与sh 
'从列A：B获取数据到变量数组
设置rngA = .Range（.Cells（2，2），.Cells（.Rows.Count，1）.End（xlUp））
 datA = rngA 
 
'创建唯一的sku和内置值字符串
对于i = 1到UBound（datA）
如果dic.Exists（datA（i，1））然后
 dic（datA（i，1））= dic（datA （i，1））& ; &安培; datA（i，2）
 Else 
 dic.Add datA（i，1），datA（i，2）
 End If 
 Next 
 
 '从列C中清除数据C：D 
设置rng = .Range（.Cells（2，4），.Cells（.Rows.Count，3）.End（xlUp））
如果rng。行> 1然后
 rng.Clear 
 End If 
 
'将结果放入列C：D 
 .Range（.Cells（2，3），.Cells（dic .Count + 1，3））= Application.Transpose（dic.Keys）
 .Range（.Cells（2，4），.Cells（dic.Count + 1，4））= Application.Transpose（dic .Items）
结束
 End Sub 
  

如何添加： / p>

• 从excel启动VBS编辑器（ Alt + F11 ）


• 显示项目资源管理器，如果它不可见（ Ctrl + R ）


• 添加一个模块（右键单击您的工作簿，插入，模块）


• 打开模块（dbl click）


• 添加 Option Explicit 作为第一行，如果还没有


• 将此代码复制到模块

如何运行它，从Excel

• 您的数据


• 打开宏对话框（ Alt + F8 ）


• 从列表中选择演示并运行

To be quite honest I am not entirely sure how to describe what it is I am trying to accomplish? But, here it goes anyway. I have an excel sheet containing one column of IDs and a second column of values that need to be associated to the first column. The problem is that the IDs in column A contain duplicates, which is okay because one ID can qualify for multiple values. What I need is to have a third column pull back the unique id, and a fourth column pull back a semi-colon delimited list of all of the values the id qualifies for. Hopefully the attached image makes sense? For what it's worth I have tried every formula I can think of, and I really know nothing about macros, which is what I am thinking needs to be implemented.

解决方案

Here's an alternative approach, that has several advantages

• it builkds the list of unique sku's
• it clear old data from columns C:D
• it will run much faster than looping over a range

---

Sub Demo()
    Dim rngA As Range, rng as Range
    Dim datA As Variant
    Dim i As Long
    Dim sh As Worksheet
    Dim dic As Object

    Set sh = ActiveSheet  ' can change this to your worksheet of choice
    Set dic = CreateObject("Scripting.Dictionary")

    With sh
        ' Get data from columns A:B into a variant array
        Set rngA = .Range(.Cells(2, 2), .Cells(.Rows.Count, 1).End(xlUp))
        datA = rngA

        ' Create list of unique sku's and built value strings
        For i = 1 To UBound(datA)
            If dic.Exists(datA(i, 1)) Then
                dic(datA(i, 1)) = dic(datA(i, 1)) & ";" & datA(i, 2)
            Else
                dic.Add datA(i, 1), datA(i, 2)
            End If
        Next

        ' Clear exisating data from columns C:D
        Set rng = .Range(.Cells(2, 4), .Cells(.Rows.Count, 3).End(xlUp))
        If rng.Row > 1 Then
            rng.Clear
        End If

        ' Put results into columns C:D
        .Range(.Cells(2, 3), .Cells(dic.Count + 1, 3)) = Application.Transpose(dic.Keys)
        .Range(.Cells(2, 4), .Cells(dic.Count + 1, 4)) = Application.Transpose(dic.Items)
    End With
End Sub

How to add this:

• Start the VBS editor (Alt+F11 from excel)
• show project explorer, if its not already visible (Ctrl+R)
• add a Module (right click on your workbook, Insert, Module)
• open the module (dbl click)
• Add Option Explicit as the first line, if not already there
• copy paste this code into module

How to run it, from Excel

• activate the sheet with your data
• open macro dialog (Alt+F8)
• select Demo from list and run

这篇关于试图找到唯一的ID，其所有的值都符合excel的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！