从Excel中的列中提取数据

Question

我在Excel中有以下数据。

CHM0123456  SRM0123:01  
CHM0123456  SRM0123:02  
CHM0123456  SRM0256:12  
CHM0123456  SRM0123:03  
CHM0123457  SRM0789:01  
CHM0123457  SRM0789:02  
CHM0123457  SRM0789:03  
CHM0123457  SRM0789:04 

我需要做的是拉出与单个CHM引用相关的所有相关SRM编号。现在我有了一个formular，它可以做这样的事情

=INDEX($C$2:$C$6, SMALL(IF($B$8=$B$2:$B$6, ROW($B$2:$B$6)-MIN(ROW($B$2:$B$6))+1, ""), ROW(A1)))

然而，这有点凌乱，我真的想用简短的vb脚本来产生同样的结果，我是否必须正确运行一个循环，然后依次检查每一行。

For x = 1 to 6555
if Ax = Chm123456 
string = string + Bx
else
next 

这应该会给我最后一个字符串

SRM0123:01,SRM123:02,SRM0256:12,SRM0123:03

以我想要的方式使用。

还是有一种更好的方法来做到这一点？

干杯

Aaron

我当前的代码

    For x = 2 To 6555
If Cells(x, 1).Value = "CHM0123456" Then
outstring = outstring + vbCr + Cells(x, 2).Value


End If


Next
MsgBox (outstring)

End Function

Answer 1

我不确定你对“整洁”的定义是什么，但我认为这是一个非常整洁、灵活而且闪电般的快速(10k+ entires没有延迟)。您传递给它您想要查找的CHM，然后是要查找的范围。您可以传递第三个可选参数来设置每个条目的分隔方式。所以在你的例子中，你可以这样写(假设你的列表是：

=列表唯一(B2，B2:B6555)

您还可以使用Char(10)作为第三个参数，通过换行符等进行分隔。

Function ListUnique(ByVal search_text As String, _
                    ByVal cell_range As range, _
                    Optional seperator As String = ", ") As String

Application.ScreenUpdating = False
Dim result As String
Dim i as Long
Dim cell As range
Dim keys As Variant
Dim dict As Object
Set dict = CreateObject("scripting.dictionary")

On Error Resume Next
For Each cell In cell_range
    If cell.Value = search_text Then
        dict.Add cell.Offset(, 1).Value, 1
    End If
Next

keys = dict.keys
For i = 0 To UBound(keys)
    result = result & (seperator & keys(i))
Next

If Len(result) <> 0 Then
    result = Right$(result, (Len(result) - Len(seperator)))
End If

ListUnique = result
Application.ScreenUpdating = True

End Function

它是如何工作的：它简单地遍历你的范围，寻找你给它的search_string。如果它找到它，它会将它添加到一个字典对象中(这将消除所有的重复项)。您将结果转储到一个数组中，然后从中创建一个字符串。从技术上讲，如果您不确定列的末尾在哪里，那么您可以将它作为搜索数组传递给它，并且此函数仍然可以正常工作(1/5秒扫描B列中的每个单元格，返回1000个唯一的命中)。

Answer 2

另一种解决方案是为Chm123456做一个高级过滤器，然后你可以将它们复制到另一个范围。如果您在字符串数组中获取它们，您可以使用内置的excel函数Join(saString，"，") (仅适用于字符串数组)。

这不是实际的代码，但它可以为您指明一个可能的方向，这可能会对您有所帮助。

好吧，对于大量的数据来说，这可能是相当快的。抓取每个单元格的数据需要大量时间，最好一次抓取所有数据。要粘贴的唯一数据，然后使用

vData=rUnique

其中vData是变体，rUnique是复制的单元格。这实际上可能比逐点抓取每个数据点更快(excel内部可以非常快地复制和粘贴)。另一种选择是在不进行复制和过去的情况下获取唯一数据，方法如下：

dim i as long
dim runique as range, reach as range
dim sData as string
dim vdata as variant

set runique=advancedfilter(...) 'Filter in place
set runique=runique.specialcells(xlCellTypeVisible)
for each reach in runique.areas
 vdata=reach
 for i=lbound(vdata) to ubound(vdata)
  sdata=sdata & vdata(i,1)
 next l
next reach

就我个人而言，我更喜欢内部复制粘贴，这样你就可以遍历每个工作表，然后在最后抓取数据(这将非常快，比遍历每个单元格更快)。所以看一遍每张纸。

dim wks as worksheet

for each wks in Activeworkbook.Worksheets
 if wks.name <> "CopiedToWorksheet" then
  advancedfilter(...) 'Copy to bottom of list, so you'll need code for that
 end if 
next wks
vdata=activeworkbook.sheets("CopiedToWorksheet").usedrange
sData=vdata(1,1)
for i=lbound(vdata) + 1 to ubound(vdata)
 sData=sData & ","
next i

上面的代码应该非常快。我不认为你可以在一个变量上使用Join，但是你可以尝试它，这会使它更快。您也可以尝试使用application.worksheetfunctions.contat (或其他任何contatenate函数)来组合结果，然后获取最终结果。

On Error Resume Next
 wks.ShowAllData
On Error GoTo 0
wks.UsedRange.Rows.Hidden = False
wks.UsedRange.Columns.Hidden = False
rFilterLocation.ClearContents