5

假设我有一个如下的 excel 电子表格：

col1 col2
------------
狗1狗
狗2狗
狗3狗
狗4狗
猫1猫
cat2 猫
cat3 猫

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

我知道我可以做一个循环来一一检查，但是VBA中有没有其他方法可以让我一次“过滤”结果？

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

请指教

问候

4

6 回答 6

2

以下是有关使用记录集返回范围的一些说明。

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
于 2008-11-11T22:24:11.553 回答
1

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

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

于 2008-11-11T19:54:01.170 回答
1

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

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

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

诚然，如果您没有 2007 年，则没有多大用处。

于 2008-11-11T21:15:51.380 回答
0

谢谢DJ。

FindAll 解决方案仍然使用 VBA 循环来执行操作。

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

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

(1) 使用 worksheetfunction.CountIf(,"Cat") 获取“cat”单元格的计数

(2) 使用 .Find("cat") 获取第一行“cat”

通过行数和第一行，我已经可以得到“猫”范围。

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

于 2008-11-11T20:10:44.503 回答
0

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

于 2008-11-11T20:33:03.757 回答
0

除非您使用的是非常老旧的机器，或者您有一个包含无数行的 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 秒。

于 2008-11-11T21:07:15.233 回答