Question

我一直在尝试编写一个通过Excel工作表的函数来查找满足特定条件的一系列单元格（同一行中的两个单元格必须相等）。

我已经编写了以下代码，这些代码逐行遍历工作表，并检查条件是否已满足。如果找到条件为真的单元格，我希望将单元格的地址添加到范围中。函数的输出最终应该是这个范围，随后用于填充符合条件的条目的对话框中的下拉菜单。

Private Function DetermineRange(WorksheetName As String, Column1 As Integer, Column2 As Integer) As Range

    Dim rng As Range

    'Go through rows of specified worksheet
    For currRow = 1 To Worksheets(WorksheetName).Cells(Rows.Count, 3).End(xlUp).Row

        'Compare cells in specified columns of current row
        If Worksheets(WorksheetName).Cells(currRow, Column1).Value = Worksheets(WorksheetName).Cells(currRow, Column2).Value _
          And Not (Worksheets(WorksheetName).Cells(currRow, Column1).Value = "") Then

            'If cells are equal, but not empty, append current adress of current cell to range
            If Not rng Is Nothing Then
                Set rng = Union(rng, Worksheets(WorksheetName).Cells(currRow, 2))
            Else
                Set rng = Worksheets(WorksheetName).Cells(currRow, 2)
            End If
        End If

    Next currRow

    If Not rng Is Nothing Then
        'return found Range
        Set DetermineRange = rng
        MsgBox ("Range is: " & rng)
    Else
        'DEBUG: Throw error message if rng is empty,
        MsgBox ("DEBUG DetermineRange Function:" & vbCrLf & _
        "Error! No corresponding Cells found in Sheet" & WorksheetName)
    End If

End Function

在行中循环工作正常，但是在条件检查到范围对象后，我似乎无法添加单元格的地址。我也尝试了以下内容，结果是

运行时错误424：需要对象

'If cells are equal, but not empty, append current address of current cell to range
 If Not rng Is Nothing Then
       Set rng = Union(rng, Worksheets(WorksheetName).Cells(currRow, 2).Address)
 Else
       Set rng = Worksheets(WorksheetName).Cells(currRow, 2).Address
 End If

我一直在寻找，但似乎无法找到有关如何将细胞添加到范围对象的更多信息，但是... 也许你们其中一个可以帮忙！任何类型的指针都在正确的方向非常感谢！

提前感谢您的任何帮助！

修改我正在调用这样的函数：

Set NameRng = DetermineRange("Features", ProjectColumn, TCGroupColumn)
cb_FcnName.RowSource = Worksheets(3).Name & "!" & NameRng.Address

但是我收到以下错误：

运行时错误380：无法设置属性RowSource

Answer 1

一种方法是捕获单元格地址。连接这些并使用最终值来构建新范围。

示例：

Public Function DetermineRange(WorksheetName As String, Column1 As Integer, Column2 As Integer) As Range
    Dim rng As Range
    Dim currRow As Integer
    Dim targetSheet As workSheet    ' Shortcut to requested sheet.
    Dim matchesFound As String      ' Address of matching cells.

    ' This line will raise an error if the name is not valid.
    Set targetSheet = ThisWorkbook.Sheets(WorksheetName)

    'Go through rows of specified worksheet
    For currRow = 1 To targetSheet.UsedRange.Rows(targetSheet.UsedRange.Rows.Count).Row

        'Compare cells in specified columns of current row
        If targetSheet.Cells(currRow, Column1).Value <> "" Then
            If targetSheet.Cells(currRow, Column1).Value = targetSheet.Cells(currRow, Column2).Value Then

                ' Capture address of matching cells.
                If Len(matchesFound) > 0 Then

                    matchesFound = matchesFound & "," & targetSheet.Cells(currRow, Column1).Address
                Else

                    matchesFound = targetSheet.Cells(currRow, Column1).Address
                End If
            End If
        End If
    Next currRow

    ' DEBUG: Throw error message if no matches found.
    If Len(matchesFound) = 0 Then

        Err.Raise vbObjectError + 101, "DetermineRange", "No matching cells found."
    End If

    ' Return range.
    Set DetermineRange = targetSheet.Range(matchesFound)
End Function

代码有点粗糙，准备好了。我不禁感到有太多的线条。但基本方法有效。

如何将当前单元格的地址附加到范围对象

1 个答案: