VBA：限制function的单元格范围
你如何在VBA中编写一个函数，让用户input一个范围作为参数，并设置该范围的上限/下限（以防input整列）？
我有一个函数，看单元格，看看它是否包含词汇表中列出的任何单词（我只是允许用户select一个列表（范围）是术语表的列表。我目前使用一个范围内的每个单元格循环遍历范围，但我不想浪费所有的单元格A列中的步骤，即使我首先检查Len（cell.value）<> 0。
我猜测它是用select语句完成的，但我现在确定如何做到这一点作为parameter passing（我现在称之为cell_range）的范围。
任何帮助将不胜感激！
已添加信息：范围的数据types是stringtypes。 这是一个英文单词（词汇表术语）的列表，我正在写一个函数，它将查看单元格，并查看它是否包含术语表中的任何术语。 如果是这样，代码返回词汇表术语加右边的偏移单元（翻译的术语）。
编辑（06.20.11）最后的代码感谢下面的实验和build议。 它需要一个单元格，并在其中查找任何术语表。 它返回术语列表，加上翻译的术语（词汇表中的第二列）。
Function FindTerm(ByVal text As String, ByVal term_list As range) As String Static glossary As Variant Dim result As String Dim i As Long glossary = range(term_list.Cells(1, 1), term_list.Cells(1, 2).End(xlDown)) For i = 1 To UBound(glossary) If InStr(text, glossary(i, 1)) <> 0 Then result = (glossary(i, 1) & " = ") & (glossary(i, 2) & vbLf) & result End If Next If result <> vbNullString Then result = Left$(result, (Len(result) - 1)) End If FindTerm = result 结束function
要回答直接问题，不能限制作为parameter passing的内容，但是可以从传递的范围中派生新的范围。
这就是说，循环遍历范围非常缓慢。 有可能的替代方法：
-
基于查询的方法，如Remou所build议的
-
将范围复制到一个变体数组并循环
Dim vDat as variant
vDat = cell_range
vDat现在是一个二维数组 -
使用内置的searchfunction查找
cell_range.Find ... -
使用
Application.WorksheetFunction.Match（和/或.Index.VLookup）
哪一个最适合取决于你的案件的具体情况
编辑
变体数组方法的演示
Function Demo(Glossary As Range, search_cell As Range) As String Dim aGlossary As Variant Dim aSearch() As String Dim i As Long, j As Long Dim FoundList As New Collection Dim result As String Dim r As Range ' put data into array aGlossary = Range(Glossary.Cells(1, 1), Glossary.Cells(1, 1).End(xlDown)) ' assuming words in search cell are space delimited aSearch = Split(search_cell.Value, " ") 'search for each word from search_cell in Glossary For i = LBound(aSearch) To UBound(aSearch) For j = LBound(aGlossary, 1) To UBound(aGlossary, 1) If aSearch(i) = aGlossary(j, 1) Then ' Add to found list FoundList.Add aSearch(i), aSearch(i) Exit For End If Next Next 'return list as comma seperated list result = "" For i = 1 To FoundList.Count result = result & "," & FoundList.Item(i) Next Demo = Mid(result, 2) End Function
为什么不能有效地限制你的循环到填充的单元格？
For Each c In Range("a:a").SpecialCells(xlCellTypeConstants) .... Next c
如果你有信心没有差距：
''Last cell in column A, or first gap oSheet.Range("a1").End(xlDown).Select ''Or last used cell in sheet - this is not very reliable, but ''may suit if the sheet is not much edited Set r1 = .Cells.SpecialCells(xlCellTypeLastCell)
否则，您可能需要http://support.microsoft.com/kb/142526来确定最后一个单元格。
编辑select列的一些注意事项
Dim r As Range Dim r1 As Range Dim r2 As Range Set r = Application.Selection Set r1 = r.Cells(1, 1) r1.Select Set r2 = r1.End(xlDown) If r2.Row > Sheet1.Cells.SpecialCells(xlCellTypeLastCell).Row Then MsgBox "Problem" Else Debug.Print r1.Address Debug.Print r2.Address End If Set r = Range(r1, r2) Debug.Print r.Address
但是，您也可以使用ADO与Excel，但它是否会为您工作取决于你想要做什么：
Dim cn As Object Dim rs As Object Dim strFile As String Dim strCon As String Dim strSQL As String Dim s As String Dim i As Integer, j As Integer Dim a As String ''It does not matter if the user has selected a whole column, ''only the data range will be picked up, nor does it matter if the ''user has selected several cells, except when it comes to the HDR ''I guess you could set HDR = Yes or No accordingly. ''One cell is slightly more difficult, but for one cell you would ''not need anything like this palaver. a = Replace(Application.Selection.Address, "$", "") ''This is not the best way to refer to the workbook ''you want, but it is very convenient for notes ''It is probably best to use the name of the workbook. strFile = ActiveWorkbook.FullName ''Note that if HDR=No, F1,F2 etc are used for column names, ''if HDR=Yes, the names in the first row of the range ''can be used. ''This is the Jet 4 connection string, you can get more ''here : http://www.connectionstrings.com/excel strCon = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & strFile _ & ";Extended Properties=""Excel 8.0;HDR=Yes;"";" ''Late binding, so no reference is needed Set cn = CreateObject("ADODB.Connection") Set rs = CreateObject("ADODB.Recordset") cn.Open strCon ''So this is not very interesting: strSQL = "SELECT * " _ & "FROM [Sheet1$" & a & "]" ''But with a little work, you could end up with: strSQL = "SELECT Gloss " _ & "FROM [Sheet1$A:A] " _ & "WHERE Gloss Like '%" & WordToFind & "%'" ''It is case sensitive, so you might prefer: strSQL = "SELECT Gloss " _ & "FROM [Sheet1$A:A] " _ & "WHERE UCase(Gloss) Like '%" & UCase(WordToFind) & "%'" rs.Open strSQL, cn, 3, 3 ''Pick a suitable empty worksheet for the results ''if you want to write out the recordset Worksheets("Sheet3").Cells(2, 1).CopyFromRecordset rs ''Tidy up rs.Close Set rs=Nothing cn.Close Set cn=Nothing