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

7

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

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

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

Cell_Image_Excel_Highlighted_B

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

Это пример, предположим, что я знаю диапазон ячеек, который может быть где угодно на листе. И я хочу сделать выбор, который включает в себя окружающую область этой клетки. Поэтому я хочу расширить / расширить. NCC
хорошо будет только одна клетка для начала? Siddharth Rout
Да, только один. Какой адрес ячейки A1, B3 и т. Д. NCC
Что вы подразумеваете под расширением. Если вы уже знаете свой диапазон эксD16:F20 тогда почему бы не использовать его напрямую? Siddharth Rout
Я попытался изменить размер, но это не похоже на работу NCC

Ваш Ответ

5   ответов
0

чтобы возвращать абсолютный адрес, я изменил синтаксис выше, чтобы вернуть диапазон. Кредит идет на Сиддхарт Рут =)

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
14

SYNTAX

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

Sub Sample()
    Debug.Print ExpandRange(Range("B5"), 1, 1, 1, 1)            '<~~ $A$4:$C$6
    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$4:$F$6
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
Error: User Rate Limit Exceeded NCC
Error: User Rate Limit Exceeded
2
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

7

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

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

Это добавит 5 к числу строк и 50 к числу столбцов. Адаптируйся под свои нужды.

3

Application.WorksheetFunction.Offset() который является более богатым, чем смещение VBA, и делает все, что требуется для вопроса.
Я думаю, что это делает то, что делает Siddharth Rout ExpandRange, без необходимости UDF.

Error: User Rate Limit Exceeded
Error: User Rate Limit Exceeded NCC
Error: User Rate Limit Exceeded NCC
Error: User Rate Limit Exceeded NCC

Похожие вопросы