Excel VBA質問箱 IV

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

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


22914 / 76738 ←次へ | 前へ→

【59196】Re:マクロでのオートSUM
発言  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

0 hits

【59109】マクロでのオートSUM tantan 08/11/29(土) 0:04 質問
【59110】Re:マクロでのオートSUM Yuki 08/11/29(土) 8:13 発言
【59111】Re:マクロでのオートSUM Hirofumi 08/11/29(土) 8:14 発言
【59116】Re:マクロでのオートSUM Hirofumi 08/11/29(土) 11:46 発言
【59130】Re:マクロでのオートSUM tantan 08/11/29(土) 23:06 質問
【59131】Re:マクロでのオートSUM Hirofumi 08/11/30(日) 0:18 回答
【59132】Re:マクロでのオートSUM Hirofumi 08/11/30(日) 0:43 回答
【59133】Re:マクロでのオートSUM tantan 08/11/30(日) 0:47 質問
【59134】Re:マクロでのオートSUM Hirofumi 08/11/30(日) 1:45 回答
【59151】Re:マクロでのオートSUM tantan 08/11/30(日) 18:54 質問
【59157】Re:マクロでのオートSUM Hirofumi 08/11/30(日) 20:48 回答
【59166】Re:マクロでのオートSUM tantan 08/12/1(月) 0:28 質問
【59168】Re:マクロでのオートSUM SS 08/12/1(月) 9:47 発言
【59195】Re:マクロでのオートSUM tantan 08/12/2(火) 0:57 質問
【59196】Re:マクロでのオートSUM ichinose 08/12/2(火) 8:09 発言
【59263】Re:マクロでのオートSUM tantan 08/12/4(木) 0:41 お礼
【59266】Re:マクロでのオートSUM ichinose 08/12/4(木) 6:22 発言
【59197】Re:マクロでのオートSUM Jaka 08/12/2(火) 9:33 発言
【59224】Re:マクロでのオートSUM Hirofumi 08/12/2(火) 18:43 回答
【59225】Re:マクロでのオートSUM Hirofumi 08/12/2(火) 19:24 回答
【59262】Re:マクロでのオートSUM tantan 08/12/4(木) 0:36 お礼
【59283】Re:マクロでのオートSUM Hirofumi 08/12/4(木) 19:29 回答
【59310】Re:マクロでのオートSUM tantan 08/12/5(金) 18:06 お礼
【59228】Re:マクロでのオートSUM n 08/12/2(火) 21:24 発言
【59264】Re:マクロでのオートSUM tantan 08/12/4(木) 1:50 質問
【59265】Re:マクロでのオートSUM n 08/12/4(木) 3:06 発言
【59311】Re:マクロでのオートSUM tantan 08/12/5(金) 18:08 お礼

22914 / 76738 ←次へ | 前へ→
ページ:  ┃  記事番号:
2610219
(SS)C-BOARD v3.8 is Free