我正在使用单个大型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?
答案 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中的数据:
将像这样在Sheet2中复制(调用它时重新对齐):
我使用的是.xlsb
文件,如果您使用.xlsm
(或.xls
用于较低版本的Excel),则可以更改connection string。您也可以在单独的工作簿中运行它,只需将dataSource
更改为目标工作簿的路径。
dataSoure = "C:\User\User.Name\MyExcel.xlsx"