|
横から失礼します。
DirectPrecedents プロパティを使ってみました。
お試しください。
Sub test()
MyCheck Range("A1")
End Sub
Sub MyCheck(Target As Range)
On Error Resume Next
Dim FirstCell As Range, r1 As Range, r2 As Range, c As Range
For Each c In Target.DirectPrecedents
If FirstCell Is Nothing Then
Set FirstCell = c
End If
If r1 Is Nothing Then
Set r1 = c.EntireRow
ElseIf Intersect(r1, c) Is Nothing Then
Set r1 = Union(r1, Range(FirstCell, c).EntireRow)
End If
If r2 Is Nothing Then
Set r2 = c.EntireColumn
ElseIf Intersect(r2, c) Is Nothing Then
Set r2 = Union(r2, Range(FirstCell, c).EntireColumn)
End If
Next
If FirstCell Is Nothing Then
MsgBox ("参照無し")
ElseIf r1.Rows.Count = 1 Then
MsgBox ("横計")
ElseIf r2.Columns.Count = 1 Then
MsgBox ("縦計")
Else
MsgBox ("それ以外")
End If
On Error GoTo 0
End Sub
|
|