Excel VBA質問箱 IV

当質問箱は、有志のボランティア精神のおかげで成り立っています。
問題が解決したら、必ずお礼をしましょうね。
本サイトの基本方針をまとめました。こちらをご一読ください。

投稿種別の選択が必要です。ご注意ください。
迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。


	新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃過去ログ ┃ホーム

22908 / 76732

←次へ　｜　前へ→


	【59196】Re:マクロでのオートＳＵＭ

ichinose - 08/12/2(火) 8:09 -


	引用なし

	パスワード

おはようございます

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

6 hits

▼

【59109】マクロでのオートＳＵＭ tantan 08/11/29(土) 0:04