VBA: ограничение диапазона ячеек с помощью функций

Question

Как вы пишете функцию в VBA, которая позволяет пользователю вводить диапазон в качестве параметра и устанавливать верхнюю / нижнюю границы для этого диапазона (в случае, если они вводят целый столбец)?

У меня есть функция, которая просматривает ячейку и определяет, содержит ли она какие-либо слова, перечисленные в глоссарии (я просто позволяю пользователю выбрать столбец (диапазон), который является списком терминов глоссария. В настоящее время я использую для каждого ячейка в цикле диапазона, чтобы пройти диапазон, но я не хочу тратить шаги, проходящие через ВСЕ ячейки в столбце А, даже если я сначала проверяю, есть ли Len (cell.value) <> 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 теперь является двумерным массивом

• Используйте встроенную функцию поиска Find
  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

Однако вы также можете использовать 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