在Excel VBA中需要最快的search方法

考虑一个场景，我有2列（列“A”和列“B”）。

A列大约有130000行/stringB列大约有10000行/string

我想从列“A”中search列“B”的每个string。

正如你所看到的数据量非常高。 我已经尝试使用Range.Find（）方法。 但是要花很多时间才能完成。 我正在寻找一种方法/方法，可以减less周转时间。

*更多关于我的要求的澄清*

（1）A和B列包含string值，而不是数字。 而且string可以非常大

（2）对于“B”列中的每个单元格，“A”列中可能出现很多

（3）我想用行号获取列“A”中列“B”的所有出现

（4）列“B”中的string。 它可以作为列“A”中的任何单元格的子string

---

下载文件链接 – wikisend.com/download/431054/StackOverFlow_Sample.xlsx *

有什么build议么 ？

随时join你需要任何额外的细节来解决上述问题！

Answer 1

尝试这个。

130000 rows in Col A花费了3秒10000 rows in Col B花费了10000 rows in Col B 。 输出在Col C生成。

注 ：我已经采取了worst情况下，列B中的所有10000值都存在列A中

这是我的数据看起来如何。

 Sub Sample() Debug.Print Now Dim col As New Collection Dim ws As Worksheet Dim i As Long Set ws = ThisWorkbook.Sheets("Sheet1") Application.ScreenUpdating = False With ws .Range("C1:C10000").Value = "No" For i = 1 To 130000 On Error Resume Next col.Add .Range("A" & i).Value, CStr(.Range("A" & i).Value) On Error GoTo 0 Next i On Error Resume Next For i = 1 To 10000 col.Add .Range("B" & i).Value, CStr(.Range("B" & i).Value) If Err.Number <> 0 Then .Range("C" & i).Value = "Yes" Err.Clear Next i End With Application.ScreenUpdating = True Debug.Print Now End Sub 

这就是结果

Answer 2

新的列A 130000个100字符的string，列B 10000个30个字符的string，27分钟。

列C填充了列Bstring出现的行位置。 列D填充了列Bstring的出现次数。

 Public Sub searchcells() Dim arrA(1 To 130000) As String, arrB(1 To 10000) As String, t As Date, nLen As Integer t = Now Me.Range("c:d") = "" For i = 1 To 130000 arrA(i) = Me.Cells(i, 1) Next For i = 1 To 10000 arrB(i) = Me.Cells(i, 2) Next For i = 1 To 130000 nLen = Len(arrA(i)) For j = 1 To 10000 If InStrRev(arrA(i), arrB(j), nLen - Len(arrB(j)) + 1) > 0 Then Me.Cells(j, 4) = Me.Cells(j, 4) + 1: Me.Cells(j, 3) = Me.Cells(j, 3) & i & "; " Next Me.Cells(1, 5) = i Next Debug.Print CDbl(Now - t) * 24 * 3600 & " seconds" End Sub 

单元格可以通过以下方式轻松填充：在每个部分中更改所需数量的string和string长度的i和j限制。

 Public Sub fillcells() Dim temp As String Randomize For i = 1 To 13000 temp = "" For j = 1 To 100 temp = temp & Chr(70 + Int(10 * Rnd())) Next Me.Cells(i, 1) = temp Next For i = 1 To 10000 temp = "" For j = 1 To 30 temp = temp & Chr(70 + Int(10 * Rnd())) Next Me.Cells(i, 2) = temp Next End Sub 

我无法在工作中下载您的电子表格，所以如果它错过了标记，请忽略它。