| |
おはようございます
Findメソッドを使った方法です。
試してみてください。
Sub Macro1()
Dim i As Long, j As Long, k As Long
Dim target As Range
With ActiveCell
If .Row > 1 Then
k = .Column
i = .Row - 1
If Range(Cells(1, k), Cells(i, k)).Count > 1 Then
Set target = get_findcell("=", Range(Cells(1, k), Cells(i, k)), Cells(1, k), xlFormulas, xlPart, xlByColumns, xlPrevious)
If target Is Nothing Then
Set target = Cells(1, k)
ElseIf target.Address <> Cells(i, k).Address Then
Set target = target.Offset(1, 0)
End If
Else
Set target = Cells(1, k)
End If
.Formula = "=sum(" & Range(target, Cells(i, k)).Address & ")"
End If
End With
End Sub
Function get_findcell(Optional ByVal f_v As Variant = "", _
Optional ByVal rng As Range = Nothing, _
Optional ByVal strng As Range = Nothing, _
Optional ByVal alookin As XlFindLookIn = -4163, _
Optional ByVal alookat As XlLookAt = 1, _
Optional ByVal aso As XlSearchOrder = 1, _
Optional ByVal asd As XlSearchDirection = 1, _
Optional ByVal mc As Boolean = False, _
Optional ByVal mb As Boolean = True) As Range
'指定された値でセル範囲を検索し､該当するセルを取得する
'input : f_v 検索する値
' rng 検索する範囲
' strng 検索開始セル
' alookin 検索対象 xlvalues,xlformulas,xlcomments
' alookat: :検索方法 1-完全一致 2-部分一致
' aso : 検索順序 1 行 2 列
' asd : 検索方向 1 Xlnext 2 XlPrevious
' mc : 大文字・小文字の区別 False しない True する
' mb : 半角と全角を区別 True する False しない
'output:get_findcell 見つかったセル(見つからなかったときはNothingが返る)
Dim 検索開始セル As Range
Static 検索範囲 As Range
Static 最初に見つかったセル As Range
Static 直前に見つかったセル As Range
Static 検索方向 As XlSearchDirection
If Not rng Is Nothing Then
Set 検索範囲 = rng
End If
If f_v <> "" Then
If strng Is Nothing Then
Set strng = 検索範囲.Cells(検索範囲.Rows.Count, 検索範囲.Columns.Count)
End If
Set get_findcell = 検索範囲.Find(f_v, strng, alookin, alookat, aso, asd)
If Not get_findcell Is Nothing Then
Set 最初に見つかったセル = get_findcell
Set 直前に見つかったセル = get_findcell
検索方向 = asd
End If
Else
If 検索方向 = xlNext Then
Set get_findcell = 検索範囲.FindNext(直前に見つかったセル)
Else
Set get_findcell = 検索範囲.FindPrevious(直前に見つかったセル)
End If
If get_findcell.Address = 最初に見つかったセル.Address Then
Set get_findcell = Nothing
Else
Set 直前に見つかったセル = get_findcell
End If
End If
End Function
|
|
![[未読]](./data/excel/image/read_icon.gif){kind=icon}
