如何用vba实现模糊查找

郁孤亭 · 发表于 2012-7-31 10:55

zhaogang1960 发表于 2012-7-30 23:05
请看附件

查帮助大概看懂了find法，做了个注释
有个问题，这个算法没有匹配度
我想做到：
完全匹配的排在最前，不完全匹配的排在后面
同匹配度的按照本来顺序（原来的姓名是有序的，所以查找结果在同匹配度内无需重新排序）。
Sub Find法()
Dim c As Range, firstAddress$, arr(), m&
ReDim arr(1 To [a65536].End(xlUp).Row, 1 To 1)
【重定义数组大小。这里1to1是干啥的？这是个一维数组吧？
【[a65536].End(xlUp).Row，a列最后一个非空单元格的行号
With Range("a:a")
      Set c = .Find([c1], , , 2)【部分匹配查找，返回单元格区域
      If Not c Is Nothing Then
         firstAddress = c.Address【单元格位置
         Do
            m = m + 1【m定义后默认初始化为0？
            arr(m, 1) = c.Offset(, 1)【区域偏移，返回匹配首字母对应的姓名
            Set c = .FindNext(c)【从当前匹配单元格后面开始，继续查找
         Loop While Not c Is Nothing And c.Address <> firstAddress【在找不到目标，或从头开始重新查找之前，循环
      End If
End With
Range("d2:d65536").ClearContents
If m > 0 Then [d2].Resize(m) = arr【d[2]……d[m+1]=arr(i)
End Sub

zhaogang1960 · 发表于 2012-7-31 11:09

郁孤亭发表于 2012-7-31 10:55
查帮助大概看懂了find法，做了个注释
有个问题，这个算法没有匹配度
我想做到：

ReDim arr(1 To [a65536].End(xlUp).Row, 1 To 1)中的1 to 1是定义数组为只有一列的二维数组，为了避开使用Transpose函数转置，以加快速度

zhaogang1960 · 发表于 2012-7-31 11:14

全匹配的在前，部分匹配的在后面：

Sub Find法()
Dim c As Range, firstAddress$, arr(), brr(), m&, n&, temp$
temp = [c1]
ReDim arr(1 To [a65536].End(xlUp).Row, 1 To 1)
ReDim brr(1 To [a65536].End(xlUp).Row, 1 To 1)
With Range("a:a")
Set c = .Find(temp, , , 2)
If Not c Is Nothing Then
firstAddress = c.Address
Do
If c.Value = temp Then
m = m + 1
arr(m, 1) = c.Offset(, 1)
Else
n = n + 1
brr(n, 1) = c.Offset(, 1)
End If
Set c = .FindNext(c)
Loop While Not c Is Nothing And c.Address <> firstAddress
End If
End With
Range("d2:d65536").ClearContents
If m > 0 Then [d2].Resize(m) = arr
If n > 0 Then [d65536].End(xlUp).Offset(1).Resize(n) = brr
End Sub

复制代码

zhaogang1960 · 发表于 2012-7-31 11:19

本帖最后由 zhaogang1960 于 2012-7-31 11:20 编辑

优化一下，使用一个数组arr：

Sub Find法()
Dim c As Range, firstAddress$, arr(), m&, n&, temp$
temp = [c1]
n = WorksheetFunction.CountIf(Range("a:a"), temp)
ReDim arr(1 To [a65536].End(xlUp).Row, 1 To 1)
With Range("a:a")
Set c = .Find(temp, , , 2)
If Not c Is Nothing Then
firstAddress = c.Address
Do
If c.Value = temp Then
m = m + 1
arr(m, 1) = c.Offset(, 1)
Else
n = n + 1
arr(n, 1) = c.Offset(, 1)
End If
Set c = .FindNext(c)
Loop While Not c Is Nothing And c.Address <> firstAddress
End If
End With
Range("d2:d65536").ClearContents
If n > 0 Then [d2].Resize(n) = arr
End Sub

复制代码

郁孤亭 · 发表于 2012-7-31 12:49

zhaogang1960 发表于 2012-7-31 11:19
优化一下，使用一个数组arr：

这么简单。呵呵。
原来我想得是完全匹配在最前，部分匹配中匹配位置次之（如查找a，找到a*），匹配位置在中间和后面的在最后（如查找a，找到*a*）。那样的话用find好像就不行，或者还要再做一次比较。

不过这样也很好了。谢谢。

郁孤亭 · 发表于 2012-7-31 13:30

zhaogang1960 发表于 2012-7-31 11:19
优化一下，使用一个数组arr：

如果输入的查找字段为小写字母，查找结果的前几个是空格。
什么原因呢？想不出来。

郁孤亭 · 发表于 2012-7-31 13:39

查找之前用VBA.UCase()进行转换，避免了问题
但为什么小写字母会有这个问题呢？

zhaogang1960 · 发表于 2012-7-31 18:00

郁孤亭发表于 2012-7-31 12:49
这么简单。呵呵。
原来我想得是完全匹配在最前，部分匹配中匹配位置次之（如查找a，找到a*），匹配位置在 ...

Find方法不支持通配符，可以在不匹配查找后再用Like结合通配符比较

zhaogang1960 · 发表于 2012-7-31 18:01

郁孤亭发表于 2012-7-31 13:30
如果输入的查找字段为小写字母，查找结果的前几个是空格。
什么原因呢？想不出来。

没有理解请上传附件说明，Find区分大小写有参数：
MatchCase Variant 类型，可选。若为 True，则进行区分大小写的查找。默认值为 False。

郁孤亭 · 发表于 2012-7-31 19:00

zhaogang1960 发表于 2012-7-31 18:01
没有理解请上传附件说明，Find区分大小写有参数：
MatchCase Variant 类型，可选。若为 True，则进 ...

模糊查找.rar (125.15 KB, 下载次数: 583)
如附件，用find法
c1=ax，则结果前面有几个空单元格
c1=AX，则没有

		自动登录	找回密码
密码			免费注册

[求助] 如何用vba实现模糊查找