Hatena::ブログ(Diary)

まりふのひと RSSフィード

訪問数:5633193直近記事一覧見かたPCRFAQ別紙ふせんSSKPro一覧)|麻里府発OneDriveiPS-BB掲示板2
MiPS予定予定一覧MAPS-TAMAPS-TPiPS-77iPS-BB)(修了:iPSなかよしiPS遊々, iPSマクロ研WAWP)|よくある質問

 

2018.7.15 (日)

家計簿内を検索する「マクロ収支シート検索.xlsm」のハイパーリンクのエラーで苦戦

  1. 家計簿77フォルダ内の xlsxファイルを「総収支」シートを検索するマクロを作った‥‥ が、
  2. 改善点が見えた
    ≪マクロの改善点≫
    • 「総収支」シートの検索ではなく、月々のシートを検索した方が、シート名に「何月」と出るので‥‥
    • Excelの検索には時間が掛かるが、最終結果を早く知ることができそう...
    ので、改修した。
  3. f:id:ogohnohito:20180710185508p:image:w240:right早速試行したら、おかしなエラーが出た‥‥
     が、[OK]したら‥‥ 終了した。
    • “Microsoft Visual Basic for Applications 400” でググった‥‥
       意外にも多くヒットしたので、1ページ分のサイトを片っ端から見た‥‥ が、思い当たる節がない...
  4. f:id:ogohnohito:20180715040527p:image:w240:right検索結果シートの Link をクリック‥‥
    • 「参照が正しくありません」と言われても、そっくりコピーの VBA だしぃ...
  5. ハイパーリンクがおかしいのでは? との思いから VBAコードを探す‥‥
    WS.Hyperlinks.Add Anchor:=WS.Range("D5").Offset(a, 0), Address:=myfolder & dirValue, SubAddress:=wkSheet.Name & "!" & c.Address,TextToDisplay:="Link"
    どうやらこの辺りに問題があるような...
  6. ‥‥ 調査に数日間 ‥‥
  7. 第95回.ハイパーリンク(Hyperlink)(エクセルの神髄|鵜原パソコンソフト研究所 - 最終更新日:2018-02-03)

    ハイパーリンクの追加

    他ブックのシートの場合
    ActiveSheet.Hyperlinks.Add Anchor:=セル, _
                 Address:="ブックのフルパス", _
                 SubAddress:="'シート名'!A1", _
                 TextToDisplay:="表示名"
    セルはRangeオブジェクトを指定

     シート名をシングルクォーテーションで囲みます。これが無いと、シート名に空白やカナ記号があると正しくハイパーリンクが設定されません。

≪結果≫
  • WS.Hyperlinks.Add の wkSheet.Name を「'」(シングルクォーティション)で括った。


2018.7.3 (火)

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

f:id:ogohnohito:20180703225807j:image:right:w240

 草刈りで使っているナイロンカッター、ブログを検索しても何時買ったのかわからない...

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ファイルの内容を検索(U君のブログ 2015-04-03)
     200近い Excelファイルがあって、しかも各ファイル内に10以上のシートがあって、その中に特定の文字列があるかどうかを調べなければいけなくなった。Excel単独の機能にはそういう検索機能はない...

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

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

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

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

  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

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

f:id:ogohnohito:20180703235322j:image:w600

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

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

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

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

≪今後≫

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

2018.4.24 (火)

Excel2013で1日2回測定の体重の折れ線グラフを作る

 4月9日の拙ブログ「ダイエットのために体重推移グラフを作ろう−初心者のためのOffice講座」で

『「初心者のためのOffice講座」(はまちゃんらんど)はあまり面白くないので今一なので俺流」で作る』
と言ったが‥‥ 言い過ぎだった。ごめんなさい。

逆に、切っ掛けをもらい、「初心者のためのOffice講座」の記事を参考に、次のようなグラフを作った。



§1.朝と夜および平均の高低線折れ線グラフ

f:id:ogohnohito:20180424235642j:image:w600


◆入力データ

 入力データは「初心者のためのOffice講座」より極力引用した。見えないデータは適当に作った。

日付平均
3/654.354.4
3/753.754.3
3/853.8
3/9 53.3
3/1053.553.4
3/11
3/1253.152.7
3/1352.453.4
3/1452.252.5
3/1552.453.7
3/1652.752.8
3/1752.452.9
3/1851.952.5
3/1952.152.7
3/205253.1
3/2152.552.6
3/225252.6
3/2353
3/2451.8
3/2551.6
3/2651.4
3/2751.6
3/2851.9
3/2952.1
3/3051.9
3/3151.9
4/1 51.7
4/2 51.7
4/3 51.6
4/4 52
4/5 52

 上記をエクセルにコピペした。

◆入力データを完成させる
  • 平均値を計算する
    • 基本的には「初心者のためのOffice講座」と同じで、例えばセルD2は
      =IF(COUNT(B2:C2)=0,NA(),AVERAGE(B2:C2))
      とした。
  • 条件付き書式を使ってエラーを見えなくする
    • 「#N/A」を見えなくする‥‥ は行わなかった。
    • ∵ 原因を作ったのは自分。「隠す前にすることがあるんじゃないの?」
  • 曜日の表示
    • 書式/ユーザー定義を “gee/mm/dd(aaa)” とし、
    • f:id:ogohnohito:20180424175816p:image:w320:right[条件付き書式]で
      • A列 を対象に、
      • 日曜日だったら、セルを薄いピンクで塗りつぶした。(右図)
◆折れ線ブラフ
  • 高低線
    1. グラフエリアを選択する。
    2. デザイン・タブ/グラフのレイアウトの[グラフ要素を追加]⇒ 線 ⇒ 高低線 を選択する。
    3. 朝と夜の折れ線は、書式設定 ⇒ 塗りつぶしと線 ⇒ 線 で、◉線なし とした。
  • グラフの炭を丸くする
    • グラフを新しいシートに移動させると無効になる。

§2.月別平均体重推移

f:id:ogohnohito:20180425010604j:image:w600


◆入力データ

 元データは§1.と全く同じ。今回は入力データから直接グラフは作らないので、シートを見出しを「入力データ」とした。


◆グラフデータ … シート見出し

 今回は入力データからグラフを作る表(グラフデータ)を作成する。f:id:ogohnohito:20180424200545j:image:w240:right

  1. 項目名
    • セルA1:日
    • セルB1:“3/1”(3月1日)を入力し、書式/ユーザー定義を“ge年m月”とする。(任意)
    • セルC1:“4/1”(4月1日)を入力し、書式設定はセルB1と同じ。
  2. 入力
    • A列:
      • セルA2〜A32まで、1から始まる連続データを入力する。
      • セルA2〜A32の書式設定/ユーザー定義を “0日” とする。
    • B列:
      1. セルB2に
        “=VLOOKUP(DATE(YEAR(B$1),MONTH(B$1),$A2),入力データ!$A$2:$D$395,4,FALSE)”
        を入力(関数のExcel ヘルプは後述)し、
      2. セルB32まで(3月は大の月のため)コピーする。
    • C列:
      1. セルB2の数式をセルC2にコピーする。
      2. セルC2の数式をセルC31まで(4月は小の月のため)コピーする。

◆折れ線ブラフの作成
  • 下降線を入れるには
    1. グラフエリアを選択する。
    2. デザイン・タブ/グラフのレイアウトの[グラフ要素を追加]⇒ 線 ⇒ 下降線 を選択する。
  • 今回は3〜4月分までのグラフに対応している。5月分に対応するにはD列を作る必要がある。

Excel ヘルプ
  • 数式:=VLOOKUP(DATE(YEAR(B$1),MONTH(B$1),$A2),入力データ!$A$2:$D$395,4,FALSE)
     説明
    1. セルB1の年,セルB1の月およびセルA2の値(日)から日付(シリアル値)を作り、
    2. この日付に等しい「入力データ」の日付を検索する。
    3. 一致するものがあれば「平均」の値(4列目)を返す。
       一致するものが無ければ #N/A となる。

      • 入力データシートの日付(A列)は昇順に並べて置く必要がある。
      • 上記数式では、検索の範囲は セルA2〜A395 となっている。
         これは、1年間分のデータに対応したため。

  • VLOOKUP関数のヘルプ
    VLOOKUP関数
     表や範囲から行ごとに数値や文字列などを検索するには、検索/行列関数の 1 つ、VLOOKUP を使用します。たとえば、部品番号によって自動車部品の価格を検索できます。
    その最も簡単な形式で、VLOOKUP 関数は次のようになります。

    = VLOOKUP (検索する値, 値を検索する範囲, 戻り値を含む範囲の列の番号, 完全一致か近似一致か - 0/FALSE か 1/TRUE で指定)。

  • DATE関数のヘルプ
    DATE 関数
     3 つの独立した値を受け取り、それらを組み合わせて日付を作成する必要がある場合は、Excel の DATE 関数を使います。
    技術的詳細
     DATE 関数は、特定の日付を表す連続したシリアル値を返します。

    書式: DATE(年,月,日)

    DATE 関数の書式には、次の引数があります。
    •  必ず指定します。年引数には、1 〜 4 桁で年を指定します。年引数の解釈は、コンピューターで使用されている日付システムによって異なります。Windows 版 Microsoft Excel の標準では 1900 年日付システムが使われます。つまり、最初の日付は 1900 年 1 月 1 日です。

      ヒント: 不適切な結果が生成されるのを防ぐため、年引数には 4 桁の数値を使用してください。たとえば、"07" を使用すると、年の値として "1907" または "2007" が返されます。4 桁の年を使用すれば混乱が防げます。
      • の値が 0 から 1899 の範囲の場合、1900 を加えた値が実際の年になります。たとえば、DATE(108,1,2) は 2008 (1900+108) 年 1 月 2 日を返します。
      • の値が 1900 から 9999 の範囲の場合、その値が実際の年になります。たとえば、DATE(2008,1,2) は 2008 年 1 月 2 日を返します。
      • の値が負の値または 10000 以上の場合、エラー値 #NUM! が返されます。
    •  必ず指定します。月を表す正または負の整数を指定します。ただし、返される値の範囲は 1 〜 12 (1 月から 12 月) になります。
      • に 12 より大きい数値を指定すると、指定した年の最初の月に、月引数を加えた月を指定したと見なされます。たとえば、DATE(2008,14,2) は 2009 年 2 月 2 日を表すシリアル値を返します。
      • に 1 より小さい数値を指定すると、指定した年の最初の月から、月引数の絶対値に 1 を加えた月数を減算した月を指定したと見なされます。たとえば、DATE(2008,-3,2) は 2007 年 9 月 2 日を表すシリアル値を返します。
    •  必ず指定します。日を表す正または負の整数を指定します。ただし、返される値の範囲は 1 〜 31 になります。
      • 指定した月の最終日より大きい数値を日に指定すると、その月の最初の日に日引数を加えた日を指定したと見なされます。たとえば、DATE(2008,1,35) は 2008 年 2 月 4 日を表すシリアル値を返します。
      • に 1 より小さい数値を指定すると、指定した月の最初の日から、日引数の絶対値に 1 を加えた日数を減算した日を指定したと見なされます。たとえば、DATE(2008,1,-15) は 2007 年 12 月 16 日を表すシリアル値を返します。

参考


追伸(2018.04.28)

  1. §1.のグラフと§2.のグラフは別の Excel ファイルで作った。
     一方『§2.の入力データは§1.と同じ』とも書いた。それならば1っの Excel ファイルで作くれるはず‥‥ なので、1っにまとめた。(Excelで体重管理.xlsx)
  2. 月内の入力データが増えると、§1.の「グラフデータの範囲」と§2.のグラフデータの「VLookup関数の範囲」を変える必要がある。特に後者は、気が使かないかも...
     そこで、
    • 入力データの範囲に「データ範囲」という名前にし、マクロ(VBA)で変更出来るようにした。(Excel体重管理.xlsm)
    • 今後の参考(修正を含む)にするため、下記に載せた。
  3. 上記2っのファイルは、圧縮し、まりふのひとの公開OneDrive\ZipLibに「Excelで体重管理」にアップする。

※ 参考)VBAコード
  1. Sub データ範囲の変更()
  2. Const conNamae As String = "データ範囲"
  3. Dim rang As Range
  4. Dim nam As Name
  5. Dim lastRow As Long
  6.   
  7.   lastRow = Cells(Rows.Count, 1).End(xlUp).Row
  8.     'グラフ1のデータ範囲を変更する。
  9.   ActiveSheet.ChartObjects(1).Chart.SetSourceData Range("A2:D" & lastRow)
  10.     
  11.     '名前:データ範囲(月別平均体重グラフのデータ範囲)を変更する。
  12.   With ActiveWorkbook
  13.       ' 2行目以降を範囲名「範囲2」にする
  14.     Set rang = .ActiveSheet.Range("A2:D" & lastRow)
  15.   
  16.     On Error Resume Next    'エラー時には次の処理へ
  17.     Set nam = .Names(conNamae)
  18.       '名前:データ範囲があれば、一旦、落とす。(範囲を変更するコードが上手く動かなかったため)
  19.     If Err = 0 Then .Names(conNamae).Delete
  20.       '名前:データ範囲を定義する。
  21.     .Names.Add Name:=conNamae, RefersTo:="=入力データ!" & rang.Address
  22.     nam.Visible = True
  23.     Err.Clear
  24.   End With
  25.   
  26. End Sub

2018.3.11 (日)

家計簿77/マクロ改修版の概要と試用のお願い

 iPS-BB(掲示板)No.833の案内

 平成29年分確定申告で「医療費の明細書」の様式が変更になりました。
これに伴い家計簿77の変更(項目追加)を余儀なくされ、急遽、マクロ家計簿77の改修を行いました。

つきましては、下記により試用版の説明会を開きますのでご意見・要望等を出してください。

  1. 日時:3月13日(火)13:00〜17:00
  2. 場所:田布施町高齢者いきいき館
  3. 内容:
    • 13:30〜15:30:マクロ家計簿77の変更点
    • 16:00〜17:00:Q&Aコーナー

で行うことを整理した。(直前まで続く予定)



家計簿77関連

◆マクロ家計簿77改修版のインストール

 新しい方法で行うので、各人のPCを確認しながら進める。

  1. バックアップ
     現在の「家計簿77」フォルダーを、フォルダー毎 圧縮し、試用直前のバックアップとする。
    1. ドキュメントを開き「家計簿77」フォルダーが見える状態にする。
    2. 「家計簿77」フォルダーを右クリック ⇒ 送る ⇒ 圧縮(zip形式)フォルダー をクリックする。
    3. 家計簿77.zip が出来、名前の変更状態になるので‥‥
    4. “家計簿77”の右に今日の日付を追加する。例えば “家計簿77_2018-0311”

  2. インストール
     Windows10のエクスプローラーの機能(マイクロソフト社のお奨め?)を使って zipファイルを「展開」してみる。
    1. 麻里府発 ⇒ まりふのひとのOneDrive に接続する。
    2. 家計簿77・フォルダーを開く。
    3. マクロ家計簿77v144a.zip を選択し、[保存]する。
    4. ダウンロードが完了したら[フォルダーを開く]。
    5. ダウンロード・フォルダーが開き、ダウンロードしたファイルが選択状態になるので、[開く]。
    6. 展開・タブがアクティブになるので、「マクロ家計簿77」を選択する。
    7. 展開先・グループが使える状態になるので (詳細)⇒ [場所の選択...]を選択する。
    8. [全て展開]をクリックすると【項目のコピー】ダイアログボックスが出るので、
      ドキュメントを開き、家計簿77・フォルダーを選択し、
    9. [コピー]する。
    10. 確認メッセージが出るので、✓ファイルを置き換える
    11. エクスプローラー、OneDrive を閉じる。

  3. バージョンの確認
    1. 家計簿77を開く。
    2. 収支シートの[メニュー]を開き
    3. タイトルバーでバージョンを確認する。(今回は version 1.44a)
    4. メニューを閉じる。


◆初期設定
  • 医区(医療費区分)列の作成
    • 作るのであれば、すべての収支シートに作る必要がある。さもないと「総収支」シートが作れない。
  • 医区(医療費区分)ボタン([I])の作成
    • これは任意。ショートカットキー(Ctrl+Shift+I)で起動できる‥‥ はず。
  • [通し]ボタンのデザインを[T]に変更 ‥‥ 面倒なので後から行う。
    • これは任意、特に変える必要性はない。無くても下記で...
    • ショートカットキー(Ctrl+Shift+T)で起動できる‥‥ はず。

◆その他の新機能
  • ショートカットキー Ctrl+Shift+D で、「同上」(〃)の機能を持たせた。

◆新機能の試用
  • 新機能は、家計簿77起動直後は利用できない。一旦、メニューを開き、閉じる 必要がある。
    • ∵ 家計簿77起動直後は、マクロ家計簿77 が開かれていないため。

Q&Aコーナー

  1. カレンダーを作成したいが上手くできない
    • Excel2007演習問題集を参考に年間カレンダーを作成した
      1. 復元したExcelファイルを開き、
      2. セルD2に開始の西暦年、セルB2に月を入力すると、1年分のカレンダーができる‥‥ はず。
        • セルを書き換えられるのはこの2ヶ所のみです!
           他のセルは数式が入っていますので、変更するとカレンダーが崩れる可能性があります。(バグが無ければ‥‥ の話)
      ≪カスタマイズ≫
       Excelそのもなので、自由に変更できる。おかしな点や提案があったらコメントしてほしい‥‥ です。
      1. セルD2は結合してあります。結合を解除しても問題ありませんが、「月」は必ずセルD2です!
      2. フォントやフォントサイズ等の設定は自由に変えられます。
        • フォントサイズを大きくするには、列の幅,行の高さも変える必要があるでしょうが、問題ありません。
        • フォントを変えると、大きさが変わることもあります。
      3. 非表示の行があります。表示しても問題ありませんが...
      4. 祝日のセルに自分で色を付けると、ズーッと残るのでおかしなことになる。

2018.2.23 (金)

マクロ家計簿77/直上の行の内容をコピーするマクロを検証中‥‥

 確定申告の作成が一段落したのでデータを保存し、昨日より2017年の女房の医療費★をまとめて入力している...


  • 女房は長年 手書きの家計簿を付けているので、それを尊重。但し、医療費は、確定申告で「医療費控除」申請をするので、領収書は保存してもらうようにしている。
  • ファイル名は「医療費R★_2017.xlsx」とし、シート見出し「2017-01」に1年分を入力する。
  • 領収書は病院(医院)別になっているので、
    • 日付は、2行目のみ年月日で入力、3行目以降は Ctrl+D でコピーし、数式バーで月日を修正した。
    • 費目は全て同じになるので、Ctrl+D
    • 備考も殆ど Ctrl+D で済む。



 自分に質問してみた...

 日付を Ctrl+D でコピーしたついでに、「費目」,「カード」,「備考」もコピーできると、入力の手間が省けるのですが‥‥

  • 例えば、スーパーで焼酎とビールをカード払い買ったとします。
    • 品名は「焼酎&ビール」とし合計金額を入力していましたが、
       1行目の品名は“〇×△焼酎”、2行目は“●×▲ビール”で入力するのが簡単になります。


  • ショートカットキーによるマクロの実行(ExcelやAccessの学習ならOfficePro)
    ‥‥ またショートカットキーは「Ctrlキー」だけではなく「Ctrlキー+Shiftキー」と何か1つの文字という組み合わせにすることもできます。「Shiftキー」も同時に押す必要がある場合には、登録する1文字を入力する時に「Shiftキー」を押しながら文字を入力して下さい。すると次の画面の用に自動的に「Ctrl+Shift」に画面表示が変わります。

    作成済みのマクロにショートカットキーを設定する

     既に記録されたマクロに後からショートカットキーを設定したり、変更したりすることも可能です。メニューの「ツール」から「マクロ」を選択し、さらに「マクロ」をクリックして下さい。
    マクロの一覧画面が表示されますので、ショートカットキーを設定したいマクロを選択してから「オプション」ボタンをクリックして下さい。
    マクロのショートカットキーの設定と説明の編集が行える画面が表示されます。


 早速マクロ(下記)を作成し、ショートカットキーとして Ctrl+Shift+D を割り当てた。

要は日付入力時 Ctrl+D の代わりに Ctrl+Shift+D すると、「日付」「品名」「費目」「カード」「備考」をコピーするもの。


 只今、検証を兼ねて、医療費★ を1年分 入力している...


◆作成したマクロ(VBA)
'カーソルが「日付」にある時、直上の行の内容をコピーする。(Ctrl+D の拡大機能)
Sub 直上のセル内容をコピーする()
Dim mbTitle As String
Dim actRow As Long, actCol As Long
Dim lastRow As Long

    mbTitle = "直上のセル内容をコピーする/" & getMacroTitle()
        '日付の最終行をセットする。
    lastRow = Cells(Rows.Count, 2).End(xlUp).Row
        'アクティブセルのアドレス
    actRow = Selection.Row
    actCol = Selection.Column
    If (actRow = 2) Or (actCol <> 2) Or (actRow <> lastRow + 1) Or (Cells(actRow, actCol) <> "") Then
        MsgBox "この機能は使えません。" & vbCrLf & vbCrLf _
                & " 1)2行目では使えません。" & vbCrLf _
                & " 2)2列目以外では使えません。" & vbCrLf _
                & " 3)直上のセルにデータが入力してある必要があります。" & vbCrLf _
                & " 4)アクティブセルは空白である必要があります。" _
                , vbCritical, mbTitle
        Exit Sub
    End If
        'Ctrl+D(同上)を行う。
    Cells(actRow, 2).FillDown   '日付
    Cells(actRow, 3).FillDown   '品名
    Cells(actRow, 4).FillDown   '費目
    Cells(actRow, 5).FillDown   'カード
    Cells(actRow, get列番号("備考")).FillDown   '備考

End Sub

'概要:引数の項目名の列番号を返す。
Function get列番号(arg項目名 As String) As Long
Dim mbTitle As String
Dim c As Long, lastColumn As Long

    mbTitle = "get列番号/" & ThisWorkbook.Name
    get列番号 = 0
    If arg項目名 = "" Then Exit Function
    
    lastColumn = Cells(1, Columns.Count).End(xlToRight).Column
    
    For c = 1 To lastColumn
        If Cells(1, c) = arg項目名 Then get列番号 = c: Exit For
    Next
    
End Function
 
迷惑コメント(英文)で困っております
コメント入力方法は
こちら を参照してください。


お世話になります

カレンダー
<< 2018/08 >>
1 2 3 4
5 6 7 8 9 10 11
12 13 14 15 16 17 18
19 20 21 22 23 24 25
26 27 28 29 30 31
おいでませ
5633194