まりふのひと

家計簿77/品名で総収支シートの最新レコードを検索・転記できるようにした

f:id:ogohnohito:20210211210941p:plain:right:w360
 マクロ家計簿77.xlsmの機能を追加し、バージョンを 1.55a とした。但し、検証が充分出来ていないので未公開中‥‥

≪目次≫


品名で総収支シートを検索し、最新レコードの値をコピペする

  1. 品名にカーソルがある時、
  2. Ctrl+Shift+F(Fは Findからとった)すると‥‥
  3. 総収支シートの同名の品名を最新を検索し、
    • 総収支シートは日付順に並んでいるはずなので、下から検索している。
  4. 費目,カード,入金等をコピペする。
    • 但し、通し番号はコピペしない。

 開発のいきさつは‥‥

  • 医療費の入力は「前回」と殆ど同じで、異なるのは金額(支出)のみ‥‥ が多いため、いちいち入力するのが面倒。

で、以前から作りたいと思っていたもの。

🌎Findで下から上へ検索したい(引用:インストラクターのネタ帳 2016年05月09日)

www.relief.jp
下から上に検索するサンプルマクロ
 以下のようなマクロで、下から上方向に検索することができます。
Sub 下から検索する()
 Dim rng As Range

 Set rng = Range("A:A").Find( _
   What:="北海道", _
   SearchDirection:=xlPrevious)

 If rng Is Nothing Then
  MsgBox "見つかりませんでした。"
 Else
  MsgBox rng.Address(False, False)
 End If
End Sub

上記のコピペで出来た。但し「完全一致」にしたいので、「マクロの記録」で作成したコードを追加した。

Sub 品名で検索() のコード
01.Public Sub 品名で検索()
02.Dim mbTitle As String
03.Dim rng As Range
04.Dim lastRow As Long, actRow As Long, sssRow As Long
05.Dim c As Long, lastCol As Long, col通し番号 As Long
06.Dim strHinmei As String
07.    
08.    mbTitle = "/" & getMacroTitle()
09.    strHinmei = ActiveCell.Value
10.    actRow = ActiveCell.Row
11.    lastCol = Cells(1, Columns.Count).End(xlToLeft).Column
12.    If strHinmei = "" Then Exit Sub
13.    LNGAns = MsgBox("下記条件で「総収支」品名を検索し、情報を付与します。" & vbCrLf _
14.            & " ◆キーワード:" & strHinmei, vbOKCancel + vbInformation, mbTitle)
15.    If LNGAns = vbCancel Then Exit Sub
16.    
17.    With Worksheets("総収支")
18.        lastRow = .Cells(Rows.Count, "C").End(xlUp).Row
19.            '完全一致で検索する。
20.        Set rng = .Range("C2:C" & lastRow).Find( _
21.                What:=strHinmei, _
22.                LookAt:=xlWhole, _
23.                SearchDirection:=xlPrevious, _
24.                MatchCase:=True, _
25.                MatchByte:=True)
26.        If rng Is Nothing Then
27.            MsgBox "総収支 シートを「" & strHinmei & "」で検索しましたが" & vbCrLf _
28.                    & "見つけられませんした。" & vbCrLf _
29.                    & "・完全一致で検索しました。" & vbCrLf _
30.                    & "・大文字/小文字は区別されます。" & vbCrLf _
31.                    & "・全角/半角は区別されます。" _
32.                    , vbCritical, mbTitle
33.            Exit Sub
34.        End If
35.'        MsgBox rng.Address(False, False)
36.        sssRow = rng.Row            '収支シートの行番号
37.        col通し番号 = get列番号("通し番号")
38.        For c = 4 To lastCol
39.            If c <> col通し番号 Then
40.                Cells(actRow, c) = .Cells(sssRow, c)
41.            End If
42.        Next
43.    End With
44.
45.End Sub

その他の改善事項

日付の年をシート名の年と自動的に同じにする(任意)

 日付の入力は通常、yy/mm で年は入力していない。
去年(2020年)の医療費をまとめて入力する時や、1月に12月の家計簿を入力する時、年を入力しないとおかしなことになってしまう。(実用上は差し支えない‥‥ はず)f:id:ogohnohito:20210211203912p:plain:right:w320
そこで、日付の年が収支シート名の年と一致しないときは、収支シートの年に置き換えられるようにした。

ユーザー設定のタブを作り、ショートカットキーで起動できるマクロを登録(任意)

f:id:ogohnohito:20210211205403p:plain

 家計簿77 タブを作り、ショートカットで起動できるマクロを登録した。(詳細は省略)
マクロの手直しが必要で、検証を進め、もっと充実させたい...