连接大数据集上的匹配

时间:2017-04-26 19:00:06

标签: excel vba

所以我一直在努力设置一个脚本来做两件事。首先是查找标识号,然后搜索所有匹配并将它们列在连接中。在确定该部分之后,我构建了一个UDF,然后创建一个UDF然后获取那些匹配并列出匹配的任何内容。 UDF低于我的水平。然而,有2个问题,我希望你能帮助它。

第一个是,它查看所有匹配并返回空格或“,”如果我指定它。我想做到这一点,除非发现匹配,否则它不会给出任何东西。

其次,文件运行速度极慢。它正在查看3个不同的电子表格,其中2个是包含数百万个单元格数据的大文件。你知道是否有办法清理这个文件以提高运行效率?它目前需要大约40-45分钟才能运行(这只是为了找到1个项目,而不是我需要查找的其他1000个项目)。

    Function DoubleLookUpConcat(ByVal SearchString As String, _
                      SearchRange As Range, _
                      ReturnRange As Range, _
                      SearchRange2 As Range, _
                      ReturnRange2 As Range, _
                      Optional Delimiter As String = " ", _
                      Optional MatchWhole As Boolean = True, _
                      Optional UniqueOnly As Boolean = False, _
                      Optional MatchCase As Boolean = False)

  Dim X As Long, CellVal As String, ReturnVal As String, Result As String

  If (SearchRange.Rows.Count > 1 And SearchRange.Columns.Count > 1) Or _
     (ReturnRange.Rows.Count > 1 And ReturnRange.Columns.Count > 1) Then
    DoubleLookUpConcat = CVErr(xlErrRef)
  Else
    If Not MatchCase Then SearchString = UCase(SearchString)
    For X = 1 To SearchRange.Count
      If MatchCase Then
        CellVal = SearchRange(X).Value
      Else
        CellVal = UCase(SearchRange(X).Value)
      End If
      ReturnVal = ReturnRange(X).Value
      ReturnVal2 = LookUpConcat(ReturnVal, SearchRange2, ReturnRange2, Delimiter, MatchWhole, UniqueOnly, MatchCase)

      If MatchWhole And CellVal = SearchString Then
        If UniqueOnly And InStr(Result & Delimiter, Delimiter & _
                ReturnVal & Delimiter) > 0 Then GoTo Continue
        Result = Result & Delimiter & ReturnVal2
      ElseIf Not MatchWhole And CellVal Like "*" & SearchString & "*" Then
        If UniqueOnly And InStr(Result & Delimiter, Delimiter & _
                ReturnVal & Delimiter) > 0 Then GoTo Continue
        Result = Result & Delimiter & ReturnVal2
      End If
Continue:
    Next

    DoubleLookUpConcat = Mid(Result, Len(Delimiter) + 1)
  End If

End Function

------------------------

Function LookUpConcat(ByVal SearchString As String, _
                      SearchRange As Range, _
                      ReturnRange As Range, _
                      Optional Delimiter As String = " ", _
                      Optional MatchWhole As Boolean = True, _
                      Optional UniqueOnly As Boolean = False, _
                      Optional MatchCase As Boolean = False)

  Dim X As Long, CellVal As String, ReturnVal As String, Result As String

  If (SearchRange.Rows.Count > 1 And SearchRange.Columns.Count > 1) Or _
     (ReturnRange.Rows.Count > 1 And ReturnRange.Columns.Count > 1) Then
    LookUpConcat = CVErr(xlErrRef)
  Else
    If Not MatchCase Then SearchString = UCase(SearchString)
    For X = 1 To SearchRange.Count
      If MatchCase Then
        CellVal = SearchRange(X).Value
      Else
        CellVal = UCase(SearchRange(X).Value)
      End If
      ReturnVal = ReturnRange(X).Value
      If MatchWhole And CellVal = SearchString Then
        If UniqueOnly And InStr(Result & Delimiter, Delimiter & _
                ReturnVal & Delimiter) > 0 Then GoTo Continue
        Result = Result & Delimiter & ReturnVal
      ElseIf Not MatchWhole And CellVal Like "*" & SearchString & "*" Then
        If UniqueOnly And InStr(Result & Delimiter, Delimiter & _
                ReturnVal & Delimiter) > 0 Then GoTo Continue
        Result = Result & Delimiter & ReturnVal
      End If
Continue:
    Next

    LookUpConcat = Mid(Result, Len(Delimiter) + 1)
  End If

End Function

enter image description here

enter image description here

enter image description here

第一张图片是我正在处理的模板B列是我需要参考的识别号码,以找到第一组匹配。列AC是连接的所有匹配。 AB栏是我需要看到的(只有在第二次搜索时找到的那个)。

第二张图像是我用来在第一张图像的B列中找到识别号码的报告。它对应于列K.它将在列U上找到与第一个图像上的列B对应的匹配。

第3张图片是我需要找到的最后一份报告,如果列U与列A匹配。如果找到原始查找中的任何匹配项,它将列出它。

0 个答案:

没有答案