Question

假设我有一张excel传播表，如下所示：

col1   col2
------------
dog1   dog
dog2   dog
dog3   dog
dog4   dog
cat1   cat
cat2   cat
cat3   cat

我想根据“狗”或“猫”返回一系列细胞（dog1，dog2，dog3，dog4）或（cat1，cat2，cat3）

我知道我可以循环检查一个接一个，但是在VBA中是否还有其他方法，所以我可以一次性“过滤”结果？

也许Range.Find（XXX）可以提供帮助，但我只看到一个单元格而不是一系列单元格的示例。

请咨询

此致

Answer 1

以下是使用记录集返回范围的一些注意事项。

Sub GetRange()
Dim cn As Object
Dim rs As Object
Dim strcn, strFile, strPos1, strPos2

    Set cn = CreateObject("ADODB.Connection")
    Set rs = CreateObject("ADODB.Recordset")

    strFile = ActiveWorkbook.FullName

    strcn = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" _
    & strFile & ";Extended Properties='Excel 8.0;HDR=Yes;IMEX=1';"

    cn.Open strcn

    rs.Open "SELECT * FROM [Sheet1$]", cn, 3 'adOpenStatic'

    rs.Find "Col2='cat'"
    strPos1 = rs.AbsolutePosition + 1
    rs.MoveLast
    If Trim(rs!Col2 & "") <> "cat" Then
        rs.Find "Col2='cat'", , -1 'adSearchBackward'
        strPos2 = rs.AbsolutePosition + 1
    Else
        strPos2 = rs.AbsolutePosition + 1
    End If
    Range("A" & strPos1, "B" & strPos2).Select
End Sub

Answer 2

这家伙有一个很好的FindAll功能：

http://www.cpearson.com/excel/findall.aspx

Answer 3

忘了另一个XL2007功能：高级过滤。如果你想在VBA中使用它，我从录制的宏中得到了这个：

Range("A1:A1000000").AdvancedFilter Action:=xlFilterCopy, CopyToRange:= Range("F1"), Unique:=True

我在大约0.35秒时计时...

不可否认，如果你没有2007年就没那么多了。

Answer 4

谢谢DJ。

FindAll解决方案仍然使用VBA循环来做事。

我正试图找到一种方法而不使用用户级循环来过滤excel VBA中的范围。

我在这里找到了解决方案。它利用excel内置引擎来完成这项工作。

（1）使用 worksheetfunction.CountIf（，“Cat”）获取“cat”单元格的计数

（2）使用.Find（“cat”）获取第一行“cat”

有行数和第一行，我已经可以获得“cat”范围了。

此解决方案的优点是：没有用户级循环，如果范围很大，这可能会提高性能。

Answer 5

Excel支持ODBC协议。我知道您可以从Access数据库连接到Excel电子表格并进行查询。我还没有这样做，但也许有一种方法可以在Excel中使用ODBC查询电子表格。

Answer 6

除非您使用的是旧版本的机器，或者您的XL2007工作表具有数十亿行，否则循环将足够快。诚实！

不相信我？看这个。我用随机字母填写了一百万行的范围：

=CHAR(RANDBETWEEN(65,90))

然后我编写了这个函数，并使用Control-Shift-Enter：

从26个单元格范围调用它

=TRANSPOSE(UniqueChars(A1:A1000000))

这是我在几分钟内被黑客攻击的非常优化的VBA功能：

Option Explicit

Public Function UniqueChars(rng As Range)

Dim dict As New Dictionary
Dim vals
Dim row As Long
Dim started As Single

    started = Timer

    vals = rng.Value2

    For row = LBound(vals, 1) To UBound(vals, 1)
        If dict.Exists(vals(row, 1)) Then
        Else
            dict.Add vals(row, 1), vals(row, 1)
        End If
    Next

    UniqueChars = dict.Items

    Debug.Print Timer - started

End Function

在我一年前的Core 2 Duo T7300（2GHz）笔记本电脑上耗时0.58秒。

如何在不使用循环的情况下返回VBA中的一系列单元格？

6 个答案: