几十万字符数据如何快速检索

lj9163510

谢谢大家，我先根据大家的思路试试，的确不清楚关键字会出现在哪一列

lovemh1987

humanmagic 发表于 2019-12-25 20:33
12W行数据3s运行时间，包含关键字的行整行高亮显示

  这个思路好 通过正则去查找

EXCELLMY

lj9163510 发表于 2019-12-26 09:09
谢谢大家，我先根据大家的思路试试，的确不清楚关键字会出现在哪一列

个人建议，根据条件表，正则匹配数据表，得到结果表

lj9163510

★NxCells（慧表），给Excel插上网络的翅膀。可视化、零编码，快速搭建各类企业信息管理系统★
12W行数据3s运行时间，包含关键字的行整行高亮显示
@5楼大师，我现在用17w行数据，关键字用1600个，测试，跑了半小时了，还没完，不知哪里出问题了

humanmagic

lj9163510 发表于 2019-12-26 10:46
★NxCells（慧表），给Excel插上网络的翅膀。可视化、零编码，快速搭建各类企业信息管理系统★
12W行数据3 ...

计算量大，你的关键字是全匹配还是部分匹配
比如关键字 aa   匹配  aac   是成功还是失败

lj9163510

@5楼大师 还是谢谢5楼大师，用您这种方法17w数据，1600对个关键字，最终用时4453.664秒，已经解决了很大问题。

lj9163510

部分匹配 关键字aa，匹配aac 也算成功

humanmagic

你的office是64位的？我的超12w就内存溢出了

HHAAMM

真的不太相信正则表达式能快过VBA的内置函数或运算符
为了避免关键字的偶然性，测试时请将sheet2的A1-A1599内设置成字符A1-A1599,A1600内设置成General（如图），这样内层循环必须要到1600，sheet1全部要染色。

1. Sub test_()
   
2.     Dim V As Variant, V2 As Variant
   
3.     Dim G(1 To 26) As String, S As String
   
4.     Dim R As Long, R2 As Long, X As Long, Y As Long, I As Long
   
5.     Dim T As Double
   
6.     Application.ScreenUpdating = False
   
7.     T = Timer
   
8.     With Sheet2
   
9.         R2 = .Range("A1").End(xlDown).Row
   
10.         V2 = .Range("A1").Resize(R2, 1).Value
    
11.         For Y = 1 To R2
    
12.             V2(Y, 1) = "*" & V2(Y, 1) & "*"
    
13.         Next
    
14.     End With
    
15.     With Sheet1
    
16.         R = .Range("A1").End(xlDown).Row
    
17.         V = .Range("A1").Resize(R, 26).Value
    
18.         For Y = 2 To R
    
19.             For X = 1 To 26
    
20.                 G(X) = V(Y, X)
    
21.             Next
    
22.             S = Join(G, Chr$(28))
    
23.             For I = 1 To R2
    
24.                 If S Like V2(I, 1) Then
    
25.                     .Range("A" & Y).Resize(1, 26).Resize(1, 26).Interior.Color = 5296274
    
26.                     Exit For
    
27.                 End If
    
28.             Next
    
29.         Next
    
30.     End With
    
31.     Debug.Print Format(Timer - T, ("0.00000"))
    
32.     Application.ScreenUpdating = True
    
33. End Sub

复制代码

一把小刀闯天下

'result数组中就是满足条件的行号，cnt为总数

'先测试一下运行时间，着色用时不会很多的，，，

Option Explicit

Sub test()
  Dim arr, i As Long, j As Long, k As Long, cnt As Long, t, dt
  Dim col As Long, row As Long, n As Long
  dt = Timer
  With Sheets("sheet1")
    col = .[a1].End(xlToRight).Column
    row = .[a1].End(xlDown).row
    ReDim pos(1 To col) As Long, mark(1 To row, 1 To 1) As String, result(1 To row) As Long
    For i = 1 To col
      t = .Cells(2, i).Value
      If Len(t) > 0 And Not IsNumeric(t) Then
        If Not IsDate(t) Then n = n + 1: pos(n) = i
      End If
    Next
    For j = 1 To n
      arr = .Cells(1, pos(j)).Resize(row).Value
      For i = 2 To row
        mark(i, 1) = mark(i, 1) & "," & arr(i, 1)
      Next
    Next
    arr = Sheets("sheet2").[a1].CurrentRegion.Resize(, 1).Value
    For i = 2 To row
      For j = 1 To UBound(arr, 1)
        If InStr(mark(i, 1), arr(j, 1)) Then cnt = cnt + 1: result(cnt) = i: Exit For
      Next
    Next
  End With
  Debug.Print Timer - dt, cnt
End Sub