まりふのひと

Excel2013で家計簿77フォルダにある全てのxlsxファイルを開き「総収支」シートがあれば検索するマクロを作った

Excel VBA


　草刈りで使っているナイロンカッター、ブログを検索しても何時買ったのかわからない...
myCollectionを検索すると、「2017-0613_静音ナイロンカッターDS-5A(紐)←やまびこ.pdf」がヒットしたので、このファイル（取扱説明書，自炊）を作ったのは 2017/06/13、これが購入日かも知れない...

　ならば家計簿を検索してみようと、2017年の家計簿を開らこう‥‥ としたが、

家計簿77・フォルダー下にある
　　my家計簿77_2014.xlsx，my家計簿77_2015.xlsx，my家計簿77_2016.xlsx，my家計簿77_2017.xlsx
　　my家計簿77_2018.xlsx ファイルを一発で検索
できたらいいなぁ〜〜〜　マクロで作れないかなぁ〜〜〜
との思いからググった。

  • 複数のExcelファイルの内容を検索（Ｕ君のブログ　2015-04-03）
    　200近い Excelファイルがあって、しかも各ファイル内に10以上のシートがあって、その中に特定の文字列があるかどうかを調べなければいけなくなった。Excel単独の機能にはそういう検索機能はない...

    　ということで調べたところ、そういう検索専用のソフトがあったけれどマクロでやる方がお手軽。スウェーデンのOscarさんという人がそういうマクロを作っていたので使わせていただく。
    　このままでも十分だけど以下のようにちょっぴり修正してから利用させていただきました。

　上記のサイトにあったコードをベースに下記を作った。

  • ファイル名：マクロ総収支検索.xlsm
  • マクロ総収支検索.xlsmがあるフォルダ、具体的には「家計簿77」フォルダにあるすべての xlsxファイルを開き、
  • 「総収支」シートがあればそのシート内を検索する。

　Ｕ君さんのお礼を兼ね、改修したコードを参考までに載せた。

  1. Public Function SearchWKBooks() As Boolean
  2. Dim mbTitle As String
  3. Const SheetName As String = "総収支"
  4. Dim WS As Worksheet
  5. Dim c
  6. Dim firstAddress
  7. Dim myfolder As String
  8. Dim dirValue As String, strString As String
  9. Dim a As Single
  10. Dim wkSheet As Worksheet
  11. 　
  12. mbTitle = "SearchWKBooks/" & ThisWorkbook.Name
  13. Set WS = Sheets.Add
  14. 　
  15. myfolder = ThisWorkbook.Path & "\"
  16. 　
  17. strString = InputBox("検索文字列を入力してください。", mbTitle, "")
  18. 　
  19. If strString = "" Then Exit Function
  20. 　
  21. 'ヘッダー部
  22. WS.Range("A1") = "検索文字列："
  23. WS.Range("B1") = strString
  24. WS.Range("A2") = "パス："
  25. WS.Range("B2") = myfolder
  26. 　
  27. WS.Range("A4") = "ファイル名"
  28. WS.Range("B4") = "シート名"
  29. WS.Range("C4") = "セル"
  30. WS.Range("D4") = "リンク"
  31. WS.Range("E4") = "セル内の文字列"
  32. 　
  33. a = 0
  34. 　
  35. Application.ScreenUpdating = False
  36. 　
  37. dirValue = Dir(myfolder & "*.xlsx")
  38. Do Until dirValue = ""
  39. Workbooks.Open Filename:=myfolder & dirValue, ReadOnly:=True, UpdateLinks:=0
  40. For Each wkSheet In ActiveWorkbook.Worksheets
  41. If wkSheet.Name = SheetName Then
  42. Set c = wkSheet.Cells.Find(strString, LookIn:=xlValues, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext)
  43. If Not c Is Nothing Then
  44. firstAddress = c.Address
  45. Do
  46. WS.Range("A5").Offset(a, 0).Value = dirValue
  47. WS.Range("B5").Offset(a, 0).Value = wkSheet.Name
  48. WS.Range("C5").Offset(a, 0).Value = c.Address
  49. WS.Hyperlinks.Add Anchor:=WS.Range("D5").Offset(a, 0), Address:=myfolder & dirValue, SubAddress:= _
  50. wkSheet.Name & "!" & c.Address, TextToDisplay:="Link"
  51. WS.Range("E5").Offset(a, 0).Value = c.Value
  52. a = a + 1
  53. Set c = wkSheet.Cells.FindNext(c)
  54. Loop While Not c Is Nothing And c.Address <> firstAddress
  55. End If
  56. End If
  57. Next wkSheet
  58. ActiveWorkbook.Close SaveChanges:=False, Filename:=myfolder & dirValue
  59. dirValue = Dir
  60. Loop
  61. 　
  62. Range("A4").Select
  63. Range(Selection, ActiveCell.SpecialCells(xlLastCell)).Select
  64. Selection.Columns.AutoFit
  65. BOOLAns = setタイトル行書式設定
  66. Range("A1").Select
  67. ActiveSheet.Name = Format(Now(), "yyyy-mmdd-hhmm")
  68. Application.ScreenUpdating = True
  69. 　
  70. Set c = Nothing
  71. Set WS = Nothing
  72. SearchWKBooks = True
  73. 　
  74. End Function


　まだ理解出来ない所が多いが、結果はすばらしい‥‥


上記は “ナイロン” で検索した結果で、行No.6 が目的のレコードと思われる。

  1. 行No.6の Link をクリックすると
  2. my家計簿_2017.xlsx が開き
  3. 総収支・シートのセルC139 がアクティブになる。

　それによると、下記であった。

  • 購入日： 2017/6/13
  • 品名：DS-5A ナイロンカッター(紐)
  • 支出：3,240円
  • 備考：アオキ農機商会
≪今後≫

　検証を重ね、マクロ家計簿77に組み込む予定...