如何在不使用循环的情况下在 VBA 中返回一系列单元格？
声明：本页面是StackOverFlow热门问题的中英对照翻译，遵循CC BY-SA 4.0协议，如果您需要使用它，必须同样遵循CC BY-SA许可，注明原文地址和作者信息，同时你必须将它归于原作者（不是我）：StackOverFlow
原文地址: http://stackoverflow.com/questions/281909/
Warning: these are provided under cc-by-sa 4.0 license. You are free to use/share it, But you must attribute it to the original authors (not me):
StackOverFlow
How to return a range of cells in VBA without using a loop?
提问by simon
let's say I have a excel spread sheet like below:
假设我有一个如下所示的 excel 电子表格：
col1 col2 ------------ dog1 dog dog2 dog dog3 dog dog4 dog cat1 cat cat2 cat cat3 cat
I want to return a range of cells (dog1,dog2,dog3,dog4) or (cat1,cat2,cat3) based on either "dog" or "cat"
我想根据“狗”或“猫”返回一系列单元格 (dog1,dog2,dog3,dog4) 或 (cat1,cat2,cat3)
I know I can do a loop to check one by one, but is there any other method in VBA so I can "filter" the result in one shot?
我知道我可以做一个循环来一个一个地检查，但是在 VBA 中还有其他方法可以让我一次性“过滤”结果吗？
maybe the Range.Find(XXX) can help, but I only see examples for just one cell not a range of cells.
也许 Range.Find(XXX) 可以提供帮助，但我只看到一个单元格的示例，而不是一系列单元格。
Please advice
请指教
Regards
问候
回答by Fionnuala
Here are some notes on using a recordset to return the range.
以下是有关使用记录集返回范围的一些注意事项。
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
回答by Mike Woodhouse
Forgot another XL2007 feature: advanced filtering. If you want it in VBA, I got this from a recorded macro:
忘记了 XL2007 的另一个功能：高级过滤。如果你想在 VBA 中使用它，我是从一个录制的宏中得到的：
Range("A1:A1000000").AdvancedFilter Action:=xlFilterCopy, CopyToRange:= Range("F1"), Unique:=True
I timed it at about 0.35 sec...
我把它计时在大约 0.35 秒...
Admittedly, not much use if you don't have 2007.
诚然，如果您没有 2007，则没有多大用处。
回答by DJ.
This guy has a nice FindAll function:
这家伙有一个很好的 FindAll 函数：
回答by simon
Thanks DJ.
谢谢DJ。
That FindAll solution still uses a VBA loop to do things.
FindAll 解决方案仍然使用 VBA 循环来做事。
I'm trying to find a way without using user level loop to filter a range in excel VBA.
我试图找到一种不使用用户级循环来过滤 excel VBA 中的范围的方法。
Here I found a solution. it takes advantage of excel built-in engine to do the job.
在这里，我找到了解决方案。它利用excel内置引擎来完成这项工作。
(1) use worksheetfunction.CountIf(,"Cat") to get the count of "cat" cells
(1) 使用 worksheetfunction.CountIf(,"Cat") 获取“cat”单元格的数量
(2) use .Find("cat") to get the first row of "cat"
(2) 使用.Find("cat") 得到"cat"的第一行
with the count of rows and the first row, I can get the "cat" range already.
有了行数和第一行，我就可以得到“猫”范围了。
The good part of this solution is: no user-level loop, this might improve the performance if the range is big.
这个解决方案的好处是：没有用户级循环，如果范围很大，这可能会提高性能。
回答by Eric Ness
Excel supports the ODBC protocol. I know that you can connect to an Excel spreadsheet from an Access database and query it. I haven't done it, but perhaps there is a way to query the spreadsheet using ODBC from inside Excel.
Excel 支持 ODBC 协议。我知道您可以从 Access 数据库连接到 Excel 电子表格并进行查询。我还没有这样做，但也许有一种方法可以从 Excel 内部使用 ODBC 查询电子表格。
回答by Mike Woodhouse
Unless you're using a veeeery old machine, or you have an XL2007 worksheet with a bazillion rows, a loop is going to be fast enough. Honest!
除非您使用的是非常旧的机器，或者您有一个包含无数行的 XL2007 工作表，否则循环将足够快。诚实！
Don't trust me? Look at this. I filled a million-row range with random letters using this:
不相信我？看这个。我用这个随机字母填充了一百万行范围：
=CHAR(RANDBETWEEN(65,90))
Then I wrote this function and called it from a 26-cell range using Control-Shift-Enter:
然后我编写了这个函数并使用 Control-Shift-Enter 从 26 个单元格范围调用它：
=TRANSPOSE(UniqueChars(A1:A1000000))
Here's the not-very-optimised VBA function I hacked out in a couple of minutes:
这是我在几分钟内破解的不是非常优化的 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
On my year-old Core 2 Duo T7300 (2GHz) laptop it took 0.58 sec.
在我一年前的 Core 2 Duo T7300 (2GHz) 笔记本电脑上，它花了 0.58 秒。
