Excel VBA: как расширить диапазон с учетом текущего выбора

Я хочу сделать что-то вроде: 

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

мое намерение состоит в том, чтобы сохранить выбор диапазона E18 (value = B) и расширьте выбор до D16:F20.

Cell_Image_Excel_Highlighted_B

если у меня есть диапазон ячейки E18 и я хочу расширить диапазон до D16:F20, Как я могу это сделать?

7
excel excel-vba selection vba

5 ответов

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: спасибо Siddharth Routh за формирование моего msg

2

ты имеешь в виду вот так?

синтаксис

ExpandRange [ряд], [количество Col слева], [количество строк сверху], [количество Col справа], [количество строк вниз]

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
13

вот простой код, который я использую для изменения размера существующего выделения.

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

это добавит 5 к числу строк и 50 к числу столбцов. Приспособьтесь к вашим потребностям.

6

можно использовать Application.WorksheetFunction.Offset() который богаче, чем смещение VBA, и делает все, что требуется вопросом.
Я думаю, что он делает то, что делает Сиддхарт Раут Экспандранге, без необходимости UDF.

3

вместо возврата абсолютного адреса я изменяю синтаксис выше, чтобы вернуть диапазон. Кредит идет на 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
0