Tested with 0.5M entries on sheet1 and 150 on sheet2:
Sub tym()
Dim ws1 As Worksheet, wb As Workbook, ws2 As Worksheet
Dim b, c As Range, rngNums As Range, rngText As Range
Dim dNums, dText, rN As Long, rT As Long, t, m
Set wb = ActiveWorkbook
Set ws1 = wb.Worksheets("Sheet1")
Set ws2 = wb.Worksheets("Sheet2")
Set c = wb.Worksheets("Sheet3").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0)
Set rngNums = ws1.Range(ws1.Range("A1"), ws1.Cells(Rows.Count, 1).End(xlUp))
dNums = rngNums.Value
Set rngText = ws2.Range(ws2.Range("A1"), ws2.Cells(Rows.Count, 1).End(xlUp))
dText = rngText.Value
t = Timer
'Method1: use if only one possible match
' (if any number from sheet1 can only appear once on sheet2)
' and sheet2 values are all of format 'text-number-text'
For rT = 1 To UBound(dText, 1)
b = CLng(Split(dText(rT, 1), "-")(1))
m = Application.Match(b, rngNums, 0)
If Not IsError(m) Then
c.Value = dText(rT, 1)
Set c = c.Offset(1, 0)
End If
Next rT
Debug.Print "Method 1", Timer - t
t = Timer
'Method2: use this if conditions above are not met...
For rN = 1 To UBound(dNums, 1)
b = "*-" & dNums(rN, 1) & "-*"
For rT = 1 To UBound(dText, 1)
If InStr(1, b, dText(rT, 1)) > 0 Then
c.Value = dText(rT, 1)
Set c = c.Offset(1, 0)
End If
Next rT
Next rN
Debug.Print "Method 2", Timer - t
End Sub
- Method1: ~0.5 sec
- Method2: ~17 sec
与恶龙缠斗过久,自身亦成为恶龙;凝视深渊过久,深渊将回以凝视…