Hatena::ブログ(Diary)

まりふのひと RSSフィード

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

 | 

2013.12.20 (金)

Excel/フィルターで「を含む」で絞り込むマクロ(2条件)

    1. Sub まめ録絞り込み()
    2. Dim mbTitle As String
    3. Dim varAns As Variant
    4. Dim strFilter1 As String, strFilter2 As String
    5.   
    6.   mbTitle = "まめ録絞り込み/" & ThisWorkbook.Name
    7.     'フィルターをオンにする。
    8.   If ActiveSheet.AutoFilterMode = False Then Range("A1").AutoFilter
    9.     'クリアする。
    10.   If ActiveSheet.AutoFilter.FilterMode Then ActiveSheet.ShowAllData
    11.   
    12.   strFilter1 = InputBox("絞り込むキーワードを入力してください。", mbTitle)
    13.   If strFilter1 = "" Then Exit Sub
    14.   strFilter2 = InputBox("or 条件のキーワードを入力してください。", mbTitle)
    15.   
    16.   If strFilter2 = "" Then
    17.     Range("A1").CurrentRegion.AutoFilter Field:=7, Criteria1:="=*" & strFilter1 & "*"
    18.   Else
    19.     Range("A1").CurrentRegion.AutoFilter Field:=7, Criteria1:="=*" & strFilter1 & "*" _
    20.         , Operator:=xlOr, Criteria2:="=*" & strFilter2 & "*"
    21.   End If
    22.   
    23. End Sub
§オートフィルタの状況を調べる (Office TANAKA)より引用

Office TANAKA のコードを参考に、Excel2010で確認した。

  1. オートフィルタを設定する。
    • Range("A1").AutoFilter
  2. オートフィルタを解除するには、もう一度 AutoFilterメソッドを実行する。
    • Range("A1").AutoFilter
  3. オートフィルタが設定されているか否かの判定
    • ActiveSheet.AutoFilterMode が True であれば設定されている。
  4. G列を“Word”を含む で絞り込む
    • Range("A1").CurrentRegion.AutoFilter Field:=7, Criteria1:="=*Word*"
  5. G列を“Word”または“ワード”を含む で絞り込む
    • Range("A1").CurrentRegion.AutoFilter Field:=7, Criteria1:="=*Word*", Operator:=xlOr, Criteria2:="=*ワード*"
  6. オートフィルターで絞り込まれているか否かの判定
    • ActiveSheet.AutoFilter.FilterMode が True であれば絞り込まれている。
  7. 絞り込みを[クリア]する
    • ActiveSheet.ShowAllData

午前/いきいきパソコン談話室(iPS遊々)の予定


 お知らせ

  • ウィルスが発生し易い季節に入りますので、セキュリティ チェックを行います。
  • あなたの「今年の漢字」または「来年の誓い」等を、Word で A4版 1ページに印刷します。
  • これまでの疑問・質問等を出してください。無ければ、談話します。

午後/iPSマクロ研の予定…マクロ残高証明の作成


 マクロ残高証明

§1.データを揃えるため、サンプルデータをダウンロードする
  1. [麻里府発]の まりふのひとの「公開」SkyDrive に入り、
  2. フォルダー「麻里府パソコン同好会」をクリックし、(開く)
  3. フォルダ「iPSマクロ研」をクリックする。 (開く)
  4. 「2013-1220_出納帳サンプルデータ」(圧縮(zip形式)フォルダ)にチェックを入れ、
  5. [ダウンロード]をクリックする。
  6. [ファイルを開く]。
  7. 「2013-1220_出納帳サンプルデータ.xlsm」を右クリック ⇒[コピー]する。
  8. 保存先フォルダーを開き‥‥ 貼り付ける。

このサンプルデータには、3っのシートがある。

  • [出納帳]シート
  • [名前]シート
    • 「前月繰越金」は、入っている前提。
  • [作業用]シート

マクロは、下記が入っている。

  • 前回作成したマクロ
     修正箇所
    1. 出納帳を集計する ‥‥ 書式はクリアしないようにした。
    2. 作業用シートのクリア ‥‥ [作業用]シートは無ければ作る。あればクリアするようにした。
  • 選択したセル内の集計と云う文字を取り去る


§2.出納帳を集計する
  1. 前回作成したマクロ(その後、一部改修)の動作確認を行う。
  2. 前回の続きのマクロを作成する。(バグがあるかも...
§2.6. マクロ名「名前の集計を取り去る」

作成済みマクロを使います。

1)操作
  1. [作業用]シートを選択する。
  2. セル A1 をクリックし、
  3. Shift+Ctrl+↓
  4. マクロ「選択したセル内の集計という文字を取り去る」を実行する。
  5. セル A1 をクリックし、選択を解除しておく。

2)得られたマクロ

コメント行は適当に加除してある。

  1. Sub 名前の集計を取り去る()
  2.   
  3.   Sheets("作業用").Select
  4.   Range("A1").Select
  5.   Range(Selection, Selection.End(xlDown)).Select
  6.   Application.Run "'2013-1220_出納帳サンプルデータ.xlsm'!選択したセル内の集計という文字を取り去る"
  7.   Range("A1").Select
  8.   
  9. End Sub

3)補完後マクロ
    1. Sub 名前の集計を取り去る()
    2.   
    3.   Sheets("作業用").Select
    4.   Range("A1").Select
    5.   Range(Selection, Selection.End(xlDown)).Select
    6.   Call 選択したセル内の集計という文字を取り去る
    7.   Range("A1").Select
    8.   
    9. End Sub



§2.7. ここまで作成したマクロを連続して動かす
  1. マクロ「aa出納帳編集」を下記のように改修後、実行する。
    1. Sub aa出納帳編集()
    2.   
    3.   Call 集計シートのクリア
    4.   Call 作業用シートのクリア
    5.   Call 出納帳を名前で並べ替える
    6.   Call 出納帳を集計する
    7.   Call 名前の集計を取り去る
    8.   
    9. End Sub

§2.8. 名前「金額リスト」を作る

次に VLookup 関数を使うため、[作業用]シートの表に「金額リスト」という名前を付ける。
但し、名前はマクロに反映されないため、マクロは作らない。

1)操作
  1. [作業用]シートを選択する。
  2. 表(A2〜D12)を選択する。
    1. セル A1 をクリックし、
    2. Shift+Ctrl+End
  3. 名前ボックスに“金額リスト”を入力する。



§2.8. マクロ名「残金を計算する」

[名前]シートを完成させる。

1)操作
  1. [作業用]シートの表の右下のアドレスの取得
    1. [作業用]シートを選択する。
    2. Ctrl+End
  2. [名前]シートを選択する。
  3. セル E2 に次の式を入力する。
    =IF(ISERROR(VLOOKUP(C2,金額リスト,3,FALSE)),0,VLOOKUP(C2,金額リスト,3,FALSE))
  4. セル F2 に次の式を入力する。
    =IF(ISERROR(VLOOKUP(C2,金額リスト,4,FALSE)),0,VLOOKUP(C2,金額リスト,4,FALSE))
  5. セル G2 に次の式を入力する。
    =D2+E2-F2
  6. 3行目以降は、計算式をコピーする。
2)得られたマクロ

コメント行は適当に加除してある。

  1. Sub 残金を集計する()
  2.   
  3.   Sheets("作業用").Select
  4.   ActiveCell.SpecialCells(xlLastCell).Select
  5.   Sheets("名前").Select
  6.   Range("E2").Select
  7.   ActiveCell.FormulaR1C1 = _
  8.     "=IF(ISERROR(VLOOKUP(RC[-2],金額リスト,3,FALSE)),0,VLOOKUP(RC[-2],金額リスト,3,FALSE))"
  9.   Range("F2").Select
  10.   ActiveCell.FormulaR1C1 = _
  11.     "=IF(ISERROR(VLOOKUP(RC[-3],金額リスト,4,FALSE)),0,VLOOKUP(RC[-3],金額リスト,4,FALSE))"
  12.   Range("G2").Select
  13.   ActiveCell.FormulaR1C1 = "=RC[-3]+RC[-2]-RC[-1]"
  14.   Range("E2:G2").Select
  15.   Selection.AutoFill Destination:=Range("E2:G21")
  16.   Range("E2:G21").Select
  17.   Range("A1").Select
  18.   
  19. End Sub
3)補完後マクロ

得られたマクロは難解です。全面的に作り変えます。

  1. Sub 残金を集計する()
  2. Dim i As Long
  3. Dim LastRow As Long
  4. Dim sRange As String
  5.   
  6.   Sheets("作業用").Select
  7.   ActiveCell.SpecialCells(xlLastCell).Select
  8.   sRange = "$A$2:" & ActiveCell.Address
  9.   
  10.   Sheets("名前").Select
  11.   Range("C1").Select
  12.   Selection.End(xlDown).Select
  13.   LastRow = ActiveCell.Row
  14.   
  15.   For i = 2 To LastRow
  16.     If IsError(Application.VLookup(Cells(i, 3), Worksheets("作業用").Range(sRange), 3, False)) Then
  17.       Cells(i, 5) = ""
  18.     Else
  19.       Cells(i, 5) = Application.VLookup(Cells(i, 3), Worksheets("作業用").Range(sRange), 3, False)
  20.     End If
  21.     
  22.     If IsError(Application.VLookup(Cells(i, 3), Worksheets("作業用").Range(sRange), 4, False)) Then
  23.       Cells(i, 6) = ""
  24.     Else
  25.       Cells(i, 6) = Application.VLookup(Cells(i, 3), Worksheets("作業用").Range(sRange), 4, False)
  26.     End If
  27.       
  28.     Cells(i, 7) = Cells(i, 4) + Cells(i, 5) - Cells(i, 6)
  29.   Next
  30.   Range("A1").Select
  31.   
  32. End Sub
≪補足説明≫
  • 7行目:Ctrl+End([作業用]シートの表の右下隅のセルをアクティブにする)
  • 8行目:VLookup で参照する表の範囲(A2〜D12)を sRange にセットする。($A$2:$D$12)
  • 12行目:Ctrl+↓
  • 13行目:C列の最終行を LastRow にセットする。
  • 15行目〜29行目:For〜Nextステートメント ‥‥ テキスト P.126 STEP6 処理を繰り返す
  • 16行目〜20行目:If〜Then〜Else〜End If ‥‥ テキスト P.102 STEP3 制御構造を使用する
  • 16行目〜17行目:VLookup関数で作業用シート $A$2:$D$12 を検索した時、見つからなかった(エラーになった)時、"" とする。
  • 19行目:見つかった時は、預り金を返す。
  • 22行目〜25行目:同様に、出金額を返す。
  • 28行目:残金額を計算する。
  • 30行目:終わったら、セルA1 をアクティブにしておく。



§2.9. マクロを完成させる

これまで作成したマクロを順に実行させるマクロを作成する。

完成したマクロ
  1. Sub aa出納帳編集()
  2.   
  3.   Call 集計シートのクリア
  4.   Call 作業用シートのクリア
  5.   Call 出納帳を名前で並べ替える
  6.   Call 出納帳を集計する
  7.   Call 名前の集計を取り去る
  8.   Call 残金を集計する
  9.   
  10. End Sub

事後放言

  1. 初めに「Excel/フィルターで「を含む」で絞り込むマクロ(2条件)」を行ったので、出だしが遅れた。
    • しかもバグがあるなんて‥‥ (Excel2007と Excel2010の違いかも知れないが未確認)
  2. 「2013-1220_出納帳サンプルデータ」(圧縮(zip形式)がアップロードしてなくて遅れた。(確認不足)
  3. 「完成したマクロ」まで走ったが、「残金を計算する」のコードは次回に持ち越した。
    • インデントの付け方がバラバラ。この辺も次回に...
 | 
迷惑コメント(英文)で困っております
コメント入力方法は
こちら を参照してください。


お世話になります

カレンダー
<< 2013/12 >>
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
おいでませ
5256454