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

【问题标题】：How to return a range of cells in VBA without using a loop?如何在不使用循环的情况下返回 VBA 中的一系列单元格？
【发布时间】：2010-09-21 20:49:04
【问题描述】：

假设我有一个如下所示的 Excel 电子表格：

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

我想根据 "dog" 或 "cat" 返回一系列单元格 (dog1,dog2,dog3,dog4) 或 (cat1,cat2,cat3)

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

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

请指教

问候

【问题讨论】：

你贴的例子看起来很奇怪，请改一下，让它可读。
这不是空格键的问题。他正在使用奇怪的字符集或其他东西。
而且它只出现在他的一些文字上？
这很奇怪，但是当您尝试删除多余的空格时，它也会删除字符。你可以试试他的旧版本之一，自己看看。
如何制作html表格？它在预览中有效，但在最终结果中无效？我希望它看起来像一个电子表格。

标签： vba excel range

【解决方案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

【讨论】：

【解决方案2】：

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

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

【讨论】：

【解决方案3】：

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

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

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

诚然，如果你没有 2007 年的话，用处不大。

【讨论】：

【解决方案4】：

谢谢DJ。

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

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

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

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

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

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

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

【讨论】：

我还发现循环通过大范围的性能可能非常慢。但是，如果您使用 VBA 并先将 Range 值转换为数组然后循环，则可以获得巨大的性能提升。即使您之后必须转换回来。

【解决方案5】：

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

【讨论】：

【解决方案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 秒。

【讨论】：