数组和对齐之间的部分匹配

Question

我正在处理一个大的Excel电子表格（数百万个数据点）。在第一列中，我有~2500个六位数的识别号码。在第二个，我有~70000 11位数字识别号码。每个6位ID包含在11个数字ID中的一个中（例如，单元格A79中的701190将与单元格B41520中的4900701190X相关联）。我想要做的是创建一个函数（或VBA代码），用于标识部分匹配和突出显示，颜色或重新排列第二个数组，以便匹配可见。我在用

=MATCH("*"&LEFT(A2,5)&"*",B2:B29,0)

这给了我C列的一个输出，它告诉我要去的正确的单元格，但这样做的时间非常密集~2500次。以下是数据的示例：

Column A   Column B 
152028     2810152006 
152032     4900152010    
152033     4900152028 
152006     380152013X 
152007     4900152033
152008     4900152007 
152010     4801152032 
152013     290152008X

仔细观察，您会发现A中包含的所有ID都可以在B中的ID中找到，但不能在任何常量位置找到，也不能在模式中找到。真实的数据远不如此。

您是否有任何建议可以轻松识别B列中的哪些ID代表A列中的ID？

Answer 1

你可以用简单的VBA做到这一点。我不确定您所声明的数据库需要多长时间，因为它必须遍历B列中A列或2500 * 70000操作中每个项目的每个项目。在我的模拟样本上，在我的计算机上，完成任务只花了三（3）分钟。

它将在列C中放置在列B中的项目中找到的项目。

您可以通过在Col C上过滤来轻松查看匹配项以排除空白。

如上所述，它不区分大小写

Option Explicit
Sub MatchWithin()
    Dim wsSrc As Worksheet, rRes As Range
    Dim vMatch As Variant, vWithin As Variant, vResults As Variant
    Dim I As Long, J As Long
    Dim sKey As String

Set wsSrc = Worksheets("sheet2")
With wsSrc
    vMatch = .Range(.Cells(1, 1), .Cells(.Rows.Count, 1).End(xlUp)).Value2
    vWithin = .Range(.Cells(1, 2), .Cells(.Rows.Count, 2).End(xlUp)).Value2
    ReDim vRes(1 To UBound(vWithin, 1), 1 To 1)
    Set rRes = .Cells(1, 3).Resize(rowsize:=UBound(vWithin, 1))
End With

For I = 1 To UBound(vMatch, 1)
    sKey = vMatch(I, 1)
    For J = 1 To UBound(vWithin, 1)
        If InStr(1, vWithin(J, 1), sKey, vbTextCompare) > 0 Then
            vRes(J, 1) = sKey
            Exit For
        End If
    Next J
Next I

'write the results

Application.ScreenUpdating = False
With rRes
    .EntireColumn.Clear
    .NumberFormat = "0"
    .Value = vRes
    .EntireColumn.ColumnWidth = 255 'so numbers don't get displayed as "#####"
    .EntireColumn.AutoFit
End With

Application.ScreenUpdating = True

End Sub

Answer 2

使用INDIRECT和ADDRESS的组合来使用现有的MATCH行将完整的ID插入到C列：

你已经找到了这行

=MATCH("*"&LEFT(A2,5)&"*",B2:B29,0)

现在使用它来获取qazxsw poi的完整单元格地址，使用2来指定col B：

ADDRESS

用INDIRECT包装它以获取单元格中包含的实际值：

=ADDRESS(MATCH("*"&LEFT(A2,5)&"*",B2:B29,0),2)

Answer 3

这可能是一种过度杀伤但如果您需要将部分匹配的11位数ID转换为6位数ID，运行如下所示的SQL查询应该可以轻而易举地获得所需的结果。

=INDIRECT(ADDRESS(MATCH("*"&LEFT(A2,5)&"*",B2:B29,0),2))

所以在Sheet1中的数据下面：

将像这样在Sheet2中复制（调用它时重新对齐）：

我使用的是和

Sub Partial()

    Dim con As Object
    Dim rec As Object
    Dim sCon As String, dataSource As String, sql As String

    '/* path of the target workbook, take note of the semi-colon */
    dataSource = ThisWorkbook.FullName & ";"
    '/* this is simply the connection string found on the link below */
    sCon = "Provider=Microsoft.ACE.OLEDB.12.0;" & _
           "Data Source=" & dataSource & _
           "Extended Properties = ""Excel 12.0;HDR=NO"";"

    Set con = CreateObject("ADODB.Connection")
    con.Open sCon
    '/* Sheet1 is where your data is, change to suit */
    '/* F1 is for Field 1 corresponding to column A, F1 - columnB and so on */
    sql = "SELECT a.[F1], b.[F2] FROM [Sheet1$] a "
    sql = sql & "INNER JOIN [Sheet1$] b ON b.[F2] LIKE '%' & a.[F1] & '%';"

    Set rec = CreateObject("ADODB.Recordset")
    rec.Open sql, con, 3, 1

    If Not rec.BOF And Not rec.EOF Then
        '/* Sheet2 is where your data should go, change to suit */
        Sheets("Sheet2").Range("A1").CopyFromRecordset rec
    End If

    rec.Close: con.Close
    Set rec = Nothing: Set con = Nothing

End Sub

文件，你可以改变.xlsb如果你使用connection string（或更低版本的Excel的.xlsm）。您也可以在单独的工作簿中运行它，只需将.xls更改为目标工作簿的路径即可。

dataSource