Question

如何在VBA中编写一个函数，让用户输入一个范围作为参数，并设置该范围的上限/下限（如果他们输入整列）？

我有一个查看单元格的函数，看它是否包含词汇表中列出的任何单词（我只是允许用户选择一个列表（范围），这是一个词汇表术语列表。我目前使用a范围循环中的单元格遍历范围，但我不想浪费步骤通过A列中的所有单元格，即使我先检查Len（cell.value）＆lt;＆gt; 0。

我猜测它是用select语句完成的，但我现在确定如何对作为参数传递的范围（我现在称之为cell_range）这样做。

非常感谢任何帮助！

添加信息：范围的数据类型是string类型。这是一个英语单词列表（术语表术语），我正在编写一个函数，它将查看单元格并查看它是否包含术语表中的任何术语。如果是，则代码返回词汇表术语加右侧的偏移单元格（翻译后的术语）。

编辑（06.20.11）通过以下实验和建议完成代码。它需要一个单元格并查找其中的任何术语表术语。它返回术语列表以及翻译的术语（术语表中的第二列）。

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

结束功能

Answer 1

为什么不有效地将循环限制在已填充的细胞中？

For Each c In Range("a:a").SpecialCells(xlCellTypeConstants)
   ....
Next c

Answer 2

要回答直接问题，您不能限制作为参数传递的内容，但您可以从传递的范围中派生新范围。

也就是说，循环一个范围非常慢。可能有其他方法：

基于查询的方法，如Remou
将范围复制到变量数组并循环遍历 Dim vDat as variant
vDat = cell_range
vDat现在是一个二维数组
使用内置搜索功能查找
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

Answer 3

如果您确信没有差距：

''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来确定最后一个单元格。

编辑有关选择专栏的一些注意事项

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

但是，您也可以在Excel中使用ADO，但它是否适合您取决于您想要做什么：

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

VBA：使用函数限制单元格范围

3 个答案: