[已解决]VBA怎么实现这样的模糊查找？

搁浅2008

4mjTZb16.rar (22.46 KB, 下载次数: 38)

2010-11-27 20:51 上传

点击文件名下载附件
VBA怎么实现这样的模糊查找？
试试我的  要是好用就给个最近啊[em04]

cxzfy12758

QUOTE:

以下是引用liuguansky在2010-11-27 20:38:00的发言：
介意给个最佳吗？

QUOTE:

不介意啊，非常感谢。

liuguansky

VBA怎么实现这样的模糊查找？

这个位置可以把你认为最能解决你问题的答案评为最佳，也是对帮你的人的一种肯定。

cxzfy12758

QUOTE:

以下是引用liuguansky在2010-11-27 21:04:00的发言：

这个位置可以把你认为最能解决你问题的答案评为最佳，也是对帮你的人的一种肯定。

我的没有出现评最佳的地方。

搁浅2008

在你认为最满意的答案 的帖子上 邮箱的后边有个设为最佳答案

cxzfy12758

QUOTE:

以下是引用fjmxwrs在2010-11-27 17:25:00的发言：

看看这是否是你想要的？

[upload=rar]viewFile.asp?ID=143323[/uplo

先满足第一个，然后在满足第二个。怎么办？谢谢

搁浅2008

QUOTE:

以下是引用搁浅2008在2010-11-27 20:51:00的发言：

[此贴子已经被作者于2010-11-27 21:58:59编辑过]

搁浅2008

修改后的代码是

Sub aa()
    Dim rng As Range
    Dim arr
    Dim a As String
    Dim i As Long
    arr = Sheet1.Range("A4:C" & Sheet1.Range("A65536").End(xlUp).Row)
    a = Sheet2.Range("A2")
    Sheet2.Range("A4:AL65536").Delete
    For i = 1 To UBound(arr, 1)
        arr(i, 1) = arr(i, 1) & arr(i, 2) & arr(i, 3)
    Next i
    For i = 1 To UBound(arr, 1)
        If InStr(arr(i, 1), a) Then
            If rng Is Nothing Then
                Set rng = Sheet1.Rows(i + 3)
            Else
                Set rng = Union(rng, Sheet1.Rows(i + 3))
            End If
        End If
    Next i
    If Not rng Is Nothing Then
        rng.Copy Destination:=Sheet2.Range("A4")
    End If
End Sub

cxzfy12758

QUOTE:

以下是引用搁浅2008在2010-11-27 22:05:00的发言：

修改后的代码是

Sub aa()
    Dim rng As Range
    Dim arr
    Dim a As String
    Dim i As Long
    arr = Sheet1.Range("A4:C" & Sheet1.Range("A65536").End(xlUp).Row)
    a = Sheet2.Range("A2")
    Sheet2.Range("A4:AL65536").Delete
    For i = 1 To UBound(arr, 1)
        arr(i, 1) = arr(i, 1) & arr(i, 2) & arr(i, 3)
    Next i
    For i = 1 To UBound(arr, 1)
        If InStr(arr(i, 1), a) Then
            If rng Is Nothing Then
                Set rng = Sheet1.Rows(i + 3)
            Else
                Set rng = Union(rng, Sheet1.Rows(i + 3))
            End If
        End If
    Next i
    If Not rng Is Nothing Then
        rng.Copy Destination:=Sheet2.Range("A4")
    End If
End Sub

我的意思是查询A2，然后还可以继续查询B2或者后面的数据。

fjmxwrs

跟来学习