仅在垂直方向获取CurrentRegion

时间:2017-11-10 14:29:04

标签: excel vba excel-vba

我想编写一个将在每个绿色单元格中使用的UDF(用户定义函数,也称为。宏)。在此函数/宏中,想要获取当前绿色单元格组旁边的框架单元格中最长字符串的长度。为了在宏中执行此操作,我需要确定一个范围,该范围表示当前单元格旁边的所有成帧单元格。 (此计算应为一个绿色组中的每个单元格生成相同的范围对象,但组与组之间的结果不同。)您将如何获得此范围?

enter image description here

我的第一次尝试就是:

Range(Application.Caller.Offset(0, -1).End(xlUp),_
      Application.Caller.Offset(0, -1).End(xlDown))

但是这个

  • 不起作用
  • 如果调用者单元格是组的最高或最低单元格,
  • 将给出错误范围。

我需要类似ActiveCell.Offset(0, -1).CurrentRegion的内容,但仅限于垂直方向。

3 个答案:

答案 0 :(得分:1)

试试这个:

Function findlongest()

Dim fullcolumn() As Variant
Dim lastrow As Long
Dim i As Long, j As Long, k As Long
Dim tmax As Long
tmax = 0
With Application.Caller
    lastrow = .Parent.Cells(.Parent.Rows.Count, .Column - 1).End(xlUp).Row
    fullcolumn = .Parent.Range(.Parent.Cells(1, .Column - 1), .Parent.Cells(lastrow, .Column - 1)).Value
    For j = .Row To 1 Step -1
        If fullcolumn(j, 1) = "" Then
            j = j + 1
            Exit For
        ElseIf j = 1 Then
            Exit For
        End If
    Next j
    For i = .Row To UBound(fullcolumn, 1)
        If fullcolumn(i, 1) = "" Then
            i = i - 1
            Exit For
        ElseIf i = UBound(fullcolumn, 1) Then
            Exit For
        End If
    Next i

    'to get the range
    Dim rng As Range
    Set rng = .Parent.Range(.Parent.Cells(j, .Column - 1), Parent.Cells(i, .Column - 1))
    'then do what you want with rng


    'but since you already have the values in an array use that instead.
    'It is quciker to iterate and array than the range.
    For k = j To i
        If Len(fullcolumn(k, 1)) > tmax Then tmax = Len(fullcolumn(k, 1))
    Next k
findlongest = tmax
End With
End Function

enter image description here

答案 1 :(得分:0)

你是否喜欢下面的代码:

Option Explicit

Sub GetLeftRange()

Dim myRng As Range

Set myRng = ActiveCell.Offset(, -1).CurrentRegion

Debug.Print myRng.Address

End Sub

注意ActiveCell是您标记为绿色的其中一个单元格。

答案 2 :(得分:0)

这是使用Area设置每个范围的示例。

Sub test()
    Dim Ws As Worksheet
    Dim rngDB As Range
    Dim rngA As Range, rng As Range

    Set Ws = ActiveSheet
    With Ws
        Set rngDB = .Range("a1", .Range("a" & Rows.Count).End(xlUp))

        Set rngA = rngDB.SpecialCells(xlCellTypeConstants, xlTextValues)
        For Each rng In rngA.Areas
            rng.Offset(, 1).Select '<~~ select is not required but is intended to be visualized
        Next rng
    End With
End Sub

enter image description here