Excel VBA：如何扩展给定当前选择的范围

Excel VBA: How to Extend a Range Given a Current Selection

提问by NCC

I want to do something like:

我想做类似的事情：

E18-(1,1) &":" &E18+(1,1)

My intent is to keep the selection of range E18(value = B) and extend the selection to D16:F20.

我的意图是保留范围的选择E18（值 = B）并将选择扩展到D16:F20.

If I have a cell's range of E18and I want to extend the range to D16:F20, how can I do this?

如果我有一个单元格的范围E18并且我想将范围扩展到D16:F20，我该怎么做？

采纳答案by NDavid RU

Range(Cells(WorksheetFunction.Max(1, Selection.Row - 1), _
      WorksheetFunction.Max(1, Selection.Column - 1)), _
      Cells(WorksheetFunction.Min(Selection.Worksheet.Rows.Count, _
      Selection.Row + 1), _
      WorksheetFunction.Min(Selection.Worksheet.Columns.Count, _
      Selection.Column + 1))).Select

upd: thanks Siddharth Rout for formating my msg

upd：感谢 Siddharth Rout 整理我的味精

回答by Siddharth Rout

You mean like this?

你的意思是这样？

SYNTAX

句法

ExpandRange [Range], [Number of Col on left], [Number of Rows on Top], [Number of Col on right], [Number of Rows down]

ExpandRange [范围]、[左侧列数]、[顶部行数]、[右侧列数]、[向下行数]

Sub Sample()
    Debug.Print ExpandRange(Range("B5"), 1, 1, 1, 1)            '<~~ $A:$C
    Debug.Print ExpandRange(Range("A1"), 1, 1, 1, 1)            '<~~ Error
    Debug.Print ExpandRange(Range("XFD4"), 1, 1, 1, 1)          '<~~ Error
    Debug.Print ExpandRange(Range("XFD1048576"), 1, 1, 1, 1)    '<~~ Error
    Debug.Print ExpandRange(Range("E5"), 1, 1, 1, 1)            '<~~ $D:$F
End Sub

Function ExpandRange(rng As Range, lft As Long, tp As Long, _
rt As Long, dwn As Long) As String
    If rng.Column - lft < 1 Or _
       rng.Row - tp < 1 Or _
       rng.Column + rt > ActiveSheet.Columns.Count Or _
       rng.Row + dwn > ActiveSheet.Rows.Count Then
        ExpandRange = "Error"
        Exit Function
    End If

    ExpandRange = Range(rng.Offset(-1 * tp, -1 * lft).Address & ":" & _
                        rng.Offset(dwn, rt).Address).Address
End Function

回答by g3t_

Here is the simple code that I use to resize an existing selection.

这是我用来调整现有选择大小的简单代码。

Selection.Resize(Selection.Rows.Count + 5, Selection.Columns.Count + 50).Select

This will add 5 to the row count and 50 to the column count. Adapt to suit your needs.

这将使行数增加 5，列数增加 50。适应您的需求。

回答by Patrick Honorez

You can use Application.WorksheetFunction.Offset()which is richer than VBA's Offset and does everything required by the question.
I think it does what Siddharth Rout ExpandRange does, without the need of a UDF.

您可以使用Application.WorksheetFunction.Offset()which 比 VBA's Offset 更丰富，并完成问题所需的一切。
我认为它可以完成 Siddharth Rout ExpandRange 所做的工作，而无需 UDF。

回答by EC_DD

Instead of returning an absolute address, I modifying the syntax above to return a range. Credit goes to Siddharth Rout = )

我没有返回绝对地址，而是修改了上面的语法以返回一个范围。归功于 Siddharth Rout = )

Function ExpandRG(rng As Variant, lft As Long, tp As Long, rt As Long, dwn As Long) _
 As Range
 Set ws = rng.Parent
If rng.Column - lft < 1 Or _
   rng.Row - tp < 1 Or _
   rng.Column + rt > ActiveSheet.Columns.Count Or _
   rng.Row + dwn > ActiveSheet.Rows.Count Then
        MsgBox "Out of range"
        Exit Function
End If

 Set rng = ws.Range(rng.Offset(-1 * tp, -1 * lft).Address & ":" & _
                    rng.Offset(dwn, rt).Address)                        
End Function

Sub aa()
Dim ori_add, O_add, New_add As Range
Set ori_add = Range("B2")
Set O_add = ori_add

Call ExpandRG(ori_add, 1, 1, 1, 1)
Set New_add = ori_add

MsgBox "Original address " & O_add.Address & ", new address is" & New_add.Address
End Sub