最快的方式

Question

我有一个表中的列字符串列表（我们说的“A”），像这样：

 A 
BJS-LAX-GRU 
CAN-ORD-MIA-BOG 
NRT-LAX-JFK-LIM 

然后我有一个不同的纸张不同的列表（让我们说“B”），像这样：

A 
LAX 
MEX 
MIA 
JFK 

所以我想知道其中第二列表的价值首先出现在第一列表中的每个字符串，那么我需要在字符串旁边写下该值。在这个例子中，我会得到：

 A    B 
BJS-LAX-GRU  LAX 
CAN-ORD-MIA-BOG MIA 
NRT-LAX-JFK-LIM LAX 

我写了下面的代码，它完美的作品：

Dim aux As Integer 
Dim cur As String 

For j = 1 To Sheets("A").Cells(Rows.Count, "A").End(xlUp).Row 
    aux = 100 
    cur = "" 
    For k = 1 To Sheets("B").Cells(Rows.Count, "A").End(xlUp).Row 
     If InStr(Sheets("A").Cells(j, 1).Value, Sheets("B").Cells(k, 1).Value) < aux And InStr(Sheets("A").Cells(j, 1).Value, Sheets("B").Cells(k, 1).Value) <> 0 Then 
      cur = Sheets("B").Cells(k, 1).Value 
      aux = InStr(Sheets("A").Cells(j, 1).Value, cur) 
     End If 
    Next k 
    Sheets("A").Cells(j, 2) = cur 
Next j 

的问题是，我知道，这个代码是非常低效的，因为这些名单有200K +行。有没有更有效的方法来做到这一点？

Answer 1

通过将数组中的值，并使用Application.Match找到匹配这应该是相当快：

Sub findmatch() 

Dim inarr() As Variant 
Dim oarr() As Variant 
Dim i As Long 
Dim str() As String 
Dim j As Integer 
Dim ws As Worksheet 
Dim tws As Worksheet 
Dim rng As Range 

Set tws = Sheets("Sheet2") 'This sheet is where the lookup list is located 
Set ws = Sheets("Sheet1") ' this is the list of names 
Set rng = tws.Range("A1", tws.Cells(tws.Rows.Count, 1).End(xlUp)) 
inarr = ws.Range("A1", ws.Cells(ws.Rows.Count, 1).End(xlUp)).Value 
ReDim oarr(1 To UBound(inarr, 1), 1 To 1) 

For i = 1 To UBound(inarr, 1) 
    str = Split(inarr(i, 1), "-") 
    For j = 0 To UBound(str) 
     Dim fnd 
     fnd = Application.Match(str(j), rng, 0) 
     If Not IsError(fnd) Then 
      oarr(i, 1) = rng(fnd) 
      Exit For 
     End If 
     oarr(i, 1) = "None" 
    Next j 
Next i 

ws.Range("B1").Resize(UBound(oarr, 1)).Value = oarr 

End Sub 

Answer 2

你可以不读值多次优化你的代码，如

表格（“B”）。单元格（k，1）。值

被多次读取，每次扫描读取一次变量，您也可以使用其他值。

作为替代战略看看Excel的搜索和查找功能

Answer 3

如果各个值都3个字母则是这样的：使用

=MID(C3,SMALL(IFERROR(SEARCH($F$3:$F$6,C3),200),1),3) 

输入作为数组公式Ctrl+Shift+Enter