'========================================================================================= ' 500 データベース（リスト）の作り方・使い方 '----------------------------------------------------------------------------------------- '【ヒント】 ' このマクロは、おためし機能の動作用のコードです '========================================================================================= ' ◆標準モジュールのコード◆ '----------------------------------------------------------------------------------------- Option Explicit Public タイトル As String Public メッセージ As String Public ラベル番号 As String '----------------------------------------------------------------------------------------- Sub おためしマクロ() Worksheets("Title").Select Range("P17").Select 'カーソルを定位置へ移動する タイトル = "500連発 第2弾 サンプルマクロ" メッセージ = "どちらを試したいですか？" With Assistant.NewBalloon .Heading = タイトル .Text = メッセージ .Labels(1).Text = "事例A_リストデータの抽出・コピー・集計" .Labels(2).Text = "事例B_お客さまIDで検索する受付システム" ラベル番号 = .Show End With If ラベル番号 = "1" Then Application.Run ("事例A_リストデータの抽出コピー集計") ElseIf ラベル番号 = "2" Then Application.Run ("事例B_受付シートをアクティブにする") End If End Sub '----------------------------------------------------------------------------------------- Sub Auto_Close() Application.DisplayAlerts = False '閉じる際に確認メッセージを出さない ActiveWorkbook.Close '現在開いているブックを閉じる End Sub '----------------------------------------------------------------------------------------- '========================================================================================= ' 500 データベース（リスト）の作り方・使い方 ' ' [事例Ａ] リストデータの抽出・コピー・集計 '----------------------------------------------------------------------------------------- '【ヒント】 ' このマクロは、おためし機能の動作用のコードを含んでいます。 ' ★★★の行またはサブプロシージャーが、タイトル機能に関係するコードです。 ' UserForm1にもコードがあり連係して動作します。 '========================================================================================= ' ◆標準モジュールのコード◆ '----------------------------------------------------------------------------------------- Option Explicit Dim 下端 As Variant Dim 右端 As Variant Dim 貼付行 As Variant Dim 横 As Variant Dim 縦 As Variant '========================================================================================= Sub オートフィルタで西田だけを抽出する() '★★★ オートフィルタで西田だけを抽出するだけ With Assistant.NewBalloon 'バルーンで説明する .Heading = タイトル .Text = "担当者が「西田」のデータだけを抽出しました" .Show End With オートフィルタをリセットする End Sub '----------------------------------------------------------------------------------------- Private Sub オートフィルタで西田だけを抽出するだけ() '★★★ Sheets("DB").Select 'DBシートを選択する Range("A2").Select Selection.AutoFilter Field:=2, Criteria1:="西田" 'オートフィルタする End Sub '----------------------------------------------------------------------------------------- Private Sub オートフィルタをリセットする() '★★★ Sheets("DB").Select 'DBシートを選択する Selection.AutoFilter 'オートフィルタをリセットする Range("A1").Select 'カーソルを定位置へ Sheets("Title").Select '初期表示シートを選択する Range("P17").Select 'カーソルを定位置へ End Sub '========================================================================================= Sub オートフィルタで抽出したデータをコピー貼り付けする() '★★★ オートフィルタで西田だけを抽出するだけ Sheets("抜出").Cells.Clear 'クリアしておく ' Sheets("DB").Select 'DBシートを選択する Selection.SpecialCells(xlVisible).Copy '可視セルを選択してコピー Sheets("抜出").Select '抜出シートを選択する Range("A1").PasteSpecial Paste:=xlValues '値だけ貼り付け Range("A1").Select 'カーソルを定位置へ With Assistant.NewBalloon 'バルーンで説明する .Text = "抽出したデータをコピー貼り付けしました" .Show End With オートフィルタをリセットする End Sub '========================================================================================= Sub ピボットテーブルで集計して報告書に加工する() '★★★ 担当者別顧客別残高をピボットテーブルで集計する ヒボットテーブルの大きさを調べる ピボットテーブルから残高データを取り出しながら報告書を作成する ActiveSheet.PrintPreview 'プレビュー ' ActiveSheet.PrintOut Copies:=1 '印刷 Sheets("Title").Select '初期表示シートを選択する Range("P17").Select 'カーソルを定位置へ End Sub '----------------------------------------------------------------------------------------- Private Sub 担当者別顧客別残高をピボットテーブルで集計する() Sheets("ピボット").Cells.Clear 'すべてクリア Sheets("DB").Select 'DBシートを選択する Range("A2").Select ActiveSheet.PivotTableWizard SourceType:=xlDatabase, SourceData:= _ "DB!R1C1:R6C6", TableDestination:="ピボット!R1C1" _ , TableName:="ﾋﾟﾎﾞｯﾄﾃｰﾌﾞﾙ1" ActiveSheet.PivotTables("ﾋﾟﾎﾞｯﾄﾃｰﾌﾞﾙ1").AddFields RowFields:="顧客名", _ ColumnFields:="担当者" ActiveSheet.PivotTables("ﾋﾟﾎﾞｯﾄﾃｰﾌﾞﾙ1").PivotFields("売掛金残高"). _ Orientation = xlDataField End Sub '----------------------------------------------------------------------------------------- Private Sub ヒボットテーブルの大きさを調べる() 下端 = Sheets("ピボット").Range("A3").End(xlDown).Row '下端検出 右端 = Sheets("ピボット").Range("A3").End(xlToRight).Column '右端検出 End Sub '----------------------------------------------------------------------------------------- Private Sub ピボットテーブルから残高データを取り出しながら報告書を作成する() Sheets("報告書").Cells.Clear '報告書シートをクリアする Sheets("テンプレート").Range("A1:C2").Copy Destination:= _ Sheets("報告書").Range("A1") 'テンプレートから報告書シートへ様式を写す ' Sheets("報告書").Select '報告書シートを選択する 貼付行 = 2 '貼付行ポインタ：報告書シートの2行目 For 横 = 2 To 右端 - 1 'ピボットテーブルのB列〜右端列-1 For 縦 = 3 To 下端 - 1 'ピボットテーブルの3行目〜最下行-1 If Sheets("ピボット").Cells(縦, 横) <> 0 Then '金額がゼロでなければ Sheets("テンプレート").Range("A2:C2").Copy Destination:= _ Sheets("報告書").Range(Cells(貼付行, 1), Cells(貼付行, 1)) '様式を写す Cells(貼付行, 1) = Sheets("ピボット").Cells(2, 横) '担当者名 Cells(貼付行, 2) = Sheets("ピボット").Cells(縦, 1) '顧客名 Cells(貼付行, 3) = Sheets("ピボット").Cells(縦, 横) '金額 貼付行 = 貼付行 + 1 '貼付行ポインタを1行あげる End If Next Next End Sub '========================================================================================= '----------------------------------------------------------------------------------------- Sub 事例A_リストデータの抽出コピー集計() Worksheets("DB").Activate 'DBシートをアクティブにする Range("A1").Select メッセージ = "どれを試しますか？" With Assistant.NewBalloon 'バルーンで説明する .Heading = タイトル .Text = メッセージ .Labels(1).Text = "オートフィルタで西田だけを抽出" .Labels(2).Text = "オートフィルタで抽出したデータをコピー貼り付け" .Labels(3).Text = "リストデータをピボットテーブルで集計して報告書に加工" ラベル番号 = .Show End With If ラベル番号 = "1" Then オートフィルタで西田だけを抽出する ElseIf ラベル番号 = "2" Then オートフィルタで抽出したデータをコピー貼り付けする ElseIf ラベル番号 = "3" Then ピボットテーブルで集計して報告書に加工する End If End Sub '----------------------------------------------------------------------------------------- '========================================================================================= ' 500 データベース（リスト）の作り方・使い方 ' ' [事例Ｂ] お客さまIDで検索する受付システム '----------------------------------------------------------------------------------------- '【ヒント】 ' このマクロは、おためし機能の動作用のコードを含んでいます。 ' ★★★の行またはサブプロシージャーが、タイトル機能に関係するコードです。 ' UserForm1にもコードがあり連係して動作します。 '========================================================================================= ' ◆標準モジュールのコード◆ '----------------------------------------------------------------------------------------- '----------------------------------------------------------------------------------------- Sub 事例B_受付シートをアクティブにする() '★★★ Worksheets("受付").Activate '受付シートをアクティブにする ' UserForm1.Show vbModeless '※1 ユーザーフォームをモードレス表示する (2000用) UserForm1.Show '※2 ユーザーフォームを表示する (97以上用) End Sub '----------------------------------------------------------------------------------------- '※1 モードレス表示は Excel2000の新機能のため、Excel97、98では実行できない '※2 Excel97、98で実行する場合は、この行を生かして、※1の行をコメント行に変えて実行する '========================================================================================= ' ◆UserForm1のコード◆ '----------------------------------------------------------------------------------------- Option Explicit Dim スタンプ As Variant '現在の日付と時刻を記憶 Dim 行 As Long '受付シートの何行目かを記憶 '----------------------------------------------------------------------------------------- ' テキストボックスから別のコントロールにフォーカスを移す直前に発生するイベントで実行するマクロ '----------------------------------------------------------------------------------------- Private Sub TextBox1_Exit(ByVal Cancel As MSForms.ReturnBoolean) If TextBox1.Text <> "" Then 'テキストボックスに何か入力されていれば Worksheets("抽出").Range("A2").Value = TextBox1.Text 'テキストを抽出シートのA2セルへ If IsError(Worksheets("抽出").Range("B2")) Then 'エラー値なら（見つからない） メッセージ = TextBox1.Text & " は見つかりません" With Assistant.NewBalloon 'バルーンで説明する .Heading = タイトル .Text = メッセージ .Show End With TextBox1.Text = "" 'クリアする Else Label2.Caption = Worksheets("抽出").Range("B2").Value '名前を表示する Label3.Caption = Worksheets("抽出").Range("C2").Value '住所を　　〃 Label7.Caption = Worksheets("抽出").Range("D2").Value '会社名を　〃 スタンプ = Now '現在日付と時刻を取得する Label8.Caption = スタンプ '　　　〃　　　　表示する End If End If End Sub '----------------------------------------------------------------------------------------- ' 「記録」ボタンがクリックされたときに実行するマクロ '----------------------------------------------------------------------------------------- Private Sub CommandButton1_Click() 行 = Worksheets("抽出").Range("E2").Value '抽出シートの何行目かを取得する Worksheets("受付").Range(Cells(行, 6), Cells(行, 6)).Value = スタンプ ' 日付と時刻を受付シートのF列の対応する行へ TextBox1.Text = "" 'テキストボックスをクリアする End Sub '----------------------------------------------------------------------------------------- ' ユーザーフォームの「×」ボタンがクリックされたときに実行するマクロ '----------------------------------------------------------------------------------------- Private Sub UserForm_Deactivate() Unload Me 'ユーザーフォームをメモリから削除する End Sub '=========================================================================================