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

时间:2018-03-01 03:25:55

标签: excel vba excel-vba excel-formula

我正在使用单个大型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?

3 个答案:

答案 0 :(得分:1)

您可以使用简单的VBA进行操作。我不确定您所声明大小的数据库需要多长时间,因为它必须遍历B列中A列或2500 * 70000操作中每个项目的每个项目。在我的模拟样本上,在我的计算机上,完成任务只花了三(3)分钟。

它会在C列中列出A列中的项目,该项目位于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

答案 1 :(得分:0)

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

您已经使用

找到了该行

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

现在使用它来获取ADDRESS的完整单元格地址,使用2来指定col B:

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

用INDIRECT包裹它以获得包含在单元格中的实际值:

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

答案 2 :(得分:0)

这可能有点过分,但如果您需要将部分匹配的11位数ID转换为6位数ID,运行如下所示的SQL查询应该可以轻而易举地为您提供所需的结果。

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

所以低于Sheet1中的数据:

Data in Sheet1

将像这样在Sheet2中复制(调用它时重新对齐):

Data in Sheet2

我使用的是.xlsb文件,如果您使用.xlsm(或.xls用于较低版本的Excel),则可以更改connection string。您也可以在单独的工作簿中运行它,只需将dataSource更改为目标工作簿的路径。

dataSoure = "C:\User\User.Name\MyExcel.xlsx"