私は次のようなことをしたい:
E18-(1,1) &":" &E18+(1,1)
私の意図は、範囲E18
(値= B)の選択を維持し、選択をに拡張することD16:F20
です。
セルの範囲がE18
あり、範囲をに拡張したいD16:F20
場合、どうすればよいですか?
こういう意味ですか?
構文
ExpandRange [範囲]、[左側の列数] 、[上部の行数]、[右側の列数]、[下の行数]
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
これは、既存の選択範囲のサイズを変更するために使用する簡単なコードです。
Selection.Resize(Selection.Rows.Count + 5, Selection.Columns.Count + 50).Select
これにより、行数に5が追加され、列数に50が追加されます。ニーズに合わせて調整してください。
Application.WorksheetFunction.Offset()
VBAのオフセットよりも豊富で、質問に必要なすべてを実行するものを使用できます。
UDFを必要とせずに、SiddharthRoutExpandRangeが実行することを実行すると思います。
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:メッセージをフォーマットしてくれたSiddharthRoutに感謝します
これは私の最初の投稿です。私はパーティーに少し遅れていることを知っています、そしてここの人々のほとんどが私よりはるかに経験豊富で熟練していることは私には明らかです。したがって、私のソリューションに「全体像」の微妙な考慮事項の多くが含まれているとは思えませんが、それらが私のために機能することを確認しました。
さて、質問に戻りましょう。これが私のやり方です。
例1
質問によって提示された正確なシナリオに対してこれを行うには、E18から開始し、範囲をD16:F20に拡張する場合は、以下のコードを使用します。フルレンジの余地がある限り、アクティブセルは実際にはどこにあってもかまいません。その範囲はそれに続きます。
Range(ActiveCell.Offset(-2, -1), ActiveCell.Offset(2, 1)).Select
例2
すでに範囲を選択していて、それをさらに拡張したい場合(たとえば、下に2行、右に1列追加)、次のようにします。
Range(Selection, Selection.Offset(2, 1)).Select
例3
データを含むすべての連続するセルの範囲を選択する場合は、アクティブセルから開始して、空白のセルに到達するまで続けて、1列から左側にセルを追加します。次に次のようにします。
Range(ActiveCell, Selection.End(xlDown).Offset(0, -1)).Select
絶対アドレスを返す代わりに、上記の構文を変更して範囲を返します。クレジットはSiddharthRoutに送られます=)
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