ＨＯＭＥ >> バックナンバー
◆◆◆◆◆◆◆◆◆◆◆◆◆◆◆◆◆◆◆◆◆◆◆◆◆◆◆◆◆◆◆◆◆◆◆
□□□□□□□□□□ □□□□□ □□□□ □□□ □□ □
「Go! Go! エクセルマクロをはじめよう！ 」
2008/08/29号 ― No. 108 ―
面倒くさ〜いルーチンワークを撃退させるソーラーマガジン
◇ ◇◇ ◇◇◇ ◇◇◇◇ ◇◇◇◇◇ ◇◇◇◇◇◇◇◇◇◇
■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■
みなさんこんにちは、三太郎です。
最新刊のバックナンバーＣＤが出ました！
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
◆シートを検索して着色するマクロの作り方
◆検索結果の数をカウントするマクロの作り方
◆価格データを一括で率計算するマクロの作り方
その他、
各回のレッスンを新収録したＣＤがセットになったマクロ学習教材です！
⇒ http://www.wat3d.com/vba/index.html
■□ 今日のもくじ――――――――――――――――――――――――――
□■
◇リクエスト紹介
◇今日の講座
＜複数シートを検索して行の一覧を表示させるマクロ＞
◇次回の予告
◇編集後記
＜祭の後・・・＞
―――――――――――――――――――――――――――――――――――
◆リクエスト紹介
―――――――――――――――――――――――――――――――――――
今回は、下記のリクエストをご紹介しています。
投稿者：さくらさん
> あるデータベース状のシート（複数あり）の中から、
> 指定の文字列にヒットしたセルのある行データ（全て）を
> 一覧表示させるマクロを作りたいのですが。。。
> 可能でしょうか？
はい、もちろん可能です。さくらさん、リクエストありがとうございます。
―――――――――――――――――――――――――――――――――――
◆今日の講座
―――――――――――――――――――――――――――――――――――
┏━━▼ Lesson 108 --- 「リクエストガンガン特集」 ---
┃
┃ ・複数シートを検索して行の一覧を表示させるマクロ（その４）
┃
┗━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━▲
今回のリクエストのマクロ作りにはポイントが以下の3つあると言いましたが、
(1) 複数のシートから検索すること。
(2) ヒットしたセルのある行の全てのデータを対象とすること。
(3) その検索結果を一覧表示させること。
前回までにこの内の(2)と(3)の部分については概ねこれで完成しましたので、
今回は、残る「(1)複数のシートから検索すること。」というところをやって
いきます。
実はこれ、プログラム的には見た目少々複雑にはなりますが、ある意味とても
簡単にできることなんです。（ちょっと難しいのは前回勉強したシート操作の
部分だけです。）
それでは早速、前回作成したエクセルマクロ"gogo107.xls"をご用意ください。
※今回からはじめてご登録いただいた皆さんへ
上記ホームページにこのメルマガのバックナンバー(No105〜No107)を公開して
いますので、まずはそちらから学習してみてください。（今回はその続きから
の内容になっています。）
◆Go!Go!ホームページ http://www.wat3d.com/gogo/
1)
まずはじめに、プログラムの中身の確認です。
――――――――――――――――――――――――――――＋
1."gogo107.xls"を開きます。（セキュリティ確認画面が表示された
場合には、[マクロを有効にする]を選んでください。）
2.マクロプログラムを表示します。
[ツール(T)] → [マクロ(M)] → [Visual Basic Editor(V)]
――――――――――――――――――――――――――――＋
＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋―
Sub Macro1()
'
b = InputBox("検索したい果物名を入力してください。")
n = Cells(Rows.Count, "A").End(xlUp).Row
For i = 1 To n
Range("A" & i).Select
a = ActiveCell.Value
If a = b Then
Rows(i & ":" & i).Select
Selection.Copy
Sheets("Sheet2").Select
n = Cells(Rows.Count, "A").End(xlUp).Row + 1
Rows(n & ":" & n).Select
ActiveSheet.Paste
Sheets("Sheet1").Select
End If
Next i
End Sub
＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋―
これは、前回までに作成した「任意の入力文字列を検索し、ヒットしたセル
のある行のデータを、結果用の別シートに一覧表示する。」といったことを
行なうマクロのプログラムです。
で、今回はこれを「複数のシートから検索する」という内容にプログラムを
拡張していきたいわけですが、その方法を一言でいってしまうと「このプロ
グラムの全体にもう一つ、シート数で繰り返すループをかぶせる。」という
ことになります。
2)
それでは、さっそくそのプログラム修正をしていきます。
――――――――――――――――――――――――――――＋
1.まず、このプログラムの一番上
b = InputBox("検索したい果物名を入力してください。")
という行の下に、下記の1行を追加します。
For j = 1 To Sheets.Count
2.次に、今度はこのプログラムの一番下
End If
の下に、いまのFor文の終わりを示す下記の1行を追加します。
Next j
3.そしたら、ちょっと大変ではありますが、
いま追加したFor〜Nextまでの間にある14行すべての字下げ
を行なってください。（ＴＡＢキーを1回ずつ14回押して）
（これは、プログラムを見やすくする為だけのもなので、
やらなくても特に処理に影響はありません。）
4.次に、最初に追加した
For j = 1 To Sheets.Count
の下に、下記の1行を追加します。
Sheets(j).Select
s = ActiveSheet.Name
5.最後に、このプログラム下方の
Sheets("Sheet1").Select
という行を、下記に修正します。
Sheets(s).Select
（カッコの中を、"Sheet1" → s に直すだけです。）
――――――――――――――――――――――――――――＋
修正した後のプログラムは下記の様になります。
＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋―
Sub Macro1()
'
b = InputBox("検索したい果物名を入力してください。")
For j = 1 To Sheets.Count
Sheets(j).Select
s = ActiveSheet.Name
n = Cells(Rows.Count, "A").End(xlUp).Row
For i = 1 To n
Range("A" & i).Select
a = ActiveCell.Value
If a = b Then
Rows(i & ":" & i).Select
Selection.Copy
Sheets("Sheet2").Select
n = Cells(Rows.Count, "A").End(xlUp).Row + 1
Rows(n & ":" & n).Select
ActiveSheet.Paste
Sheets(s).Select
End If
Next i
Next j
End Sub
＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋―
いま最初の1.で追加したFor文の「Sheets.Count」というのは、既に何度かこ
の講座でも出てきましたので覚えのある方もあるかと思いますが、これはシ
ートの数を示すものです。
例えば、いまこのエクセルブックにはデフォルトで用意されている[Sheet1]
と[Sheet2]と[Sheet3]の計3つのシートが存在していますので、
この場合は Sheets.Count=3 ということになり、このループ処理は3回繰り返
されることとなります。
それで、今回肝心なのがいま4.で追加した2行のプログラムなのですが、これ
はどちらも、シート操作では最も重要な基本構文です。
まず最初の「Sheets(j).Select」ですが、前回もやりましたように、例えば
「Sheets("Sheet1").Select」なら"Sheet1"という名前の付いたシートを開く
という意味なので、これは要するに名前を指定してシートを開く方法です。
一方、今回の「Sheets(j).Select」では、「 j 番目のシートを開く」という
意味になります。（この場合の j はループの回数をカウントする数字です。）
エクセルのシートには、名前(シート名)の他に(内部的な)識別番号というもの
が割り振られています。
例えば、このBookでは、
シート名[Sheet1]・・・識別番号1
シート名[Sheet2]・・・識別番号2
シート名[Sheet3]・・・識別番号3
というようになっており、
仮に、ここで[Sheet1]をシートごと削除した場合では残った2つのシートの識
別番号は、
シート名[Sheet2]・・・識別番号1
シート名[Sheet3]・・・識別番号2
といった具合になります。
で、プログラム上でこの識別番号を用いることで、名前が分からない(または
名前をその都度変更したいような)シートの場合でも、この番号で順番に開い
ていくということが、マクロでは容易に可能なわけです。
そうして、シートは開いておきさえすれば、次の「s = ActiveSheet.Name」
で簡単にそのシート名を取得することができますので、その後の処理は、前回
勉強したように「 Sheets("シート名").Select 」という、たった1行を正しく
追加していけだよいというだけになります。
さて、ここで一つ注意しておかなければならないのが、このシート数だけ繰り
返すといったループ処理では、出力用のシート（このマクロの場合でいうと、
[Sheet2]のことです。）を検索対象から除く必要があるということです。
3)
ということで、もう少しこのプログラムに修正を加えていきます。
――――――――――――――――――――――――――――＋
1.まず、プログラム前方の
s = ActiveSheet.Name
という行の下に、下記の1行を追加します。
If s <> "Sheet2" Then
2.次に、プログラム後方の「Next i」と「Next j」の間に
下記の1行を追加します。
End If
3.そしたら、またちょっと大変ではありますが、
いま追加した「If s <> "Sheet2" Then」〜「End If」まで
の間にある行の字下げというのをちゃんと行なってください。
――――――――――――――――――――――――――――＋
修正した後のプログラムはつぎの様になります。
＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋―
Sub Macro1()
'
b = InputBox("検索したい果物名を入力してください。")
For j = 1 To Sheets.Count
Sheets(j).Select
s = ActiveSheet.Name
If s <> "Sheet2" Then
n = Cells(Rows.Count, "A").End(xlUp).Row
For i = 1 To n
Range("A" & i).Select
a = ActiveCell.Value
If a = b Then
Rows(i & ":" & i).Select
Selection.Copy
Sheets("Sheet2").Select
n = Cells(Rows.Count, "A").End(xlUp).Row + 1
Rows(n & ":" & n).Select
ActiveSheet.Paste
Sheets(s).Select
End If
Next i
End If
Next j
End Sub
＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋―
このような、分岐処理(IF文)をちょっと追加するだけで、この問題は解決でき
るというわけです。
4)
それでは、実行してみましょう。
――――――――――――――――――――――――――――＋
1.エクセルの画面に戻って、まず実行する前にシート[Sheet2]を開いて、
このシートにいま表示されている見出し以外のデータを(2行目以降を)
全て削除してください。
2.次に、C1のセル(ＮＯの隣)に、 シート名 と入力してください。
3.次に、テスト用のデータを入力します。
以下のテキスト（10行）をコピーして、[Sheet1]のセルA1の位置に
そのまま貼り付けてください。（今あるデータに上書きしてください。）
くだもの名
りんご
みかん
いちご
りんご
みかん
いちご
りんご
みかん
いちご
4.続けて、このデータに番号を振っておきます。
以下のテキスト（10行）をコピーして、セルB1の位置にそのまま
貼り付けてください。
NO
1
2
3
4
5
6
7
8
9
5.続けて、もう一つこのデータの在りか(シート名)が分かるように、
以下のテキスト（10行）をコピーして、セルC1の位置にそのまま
貼り付けてください。
シート名
[Sheet1]
[Sheet1]
[Sheet1]
[Sheet1]
[Sheet1]
[Sheet1]
[Sheet1]
[Sheet1]
[Sheet1]
6.更に、同様にして今度は[Sheet3]の方にもテスト用のデータを入力します。
以下のテキスト（10行）をコピーして、[Sheet3]のセルA1の位置に
そのまま貼り付けてください。（今あるデータに上書きしてください。）
くだもの名
りんご
りんご
りんご
みかん
みかん
みかん
いちご
いちご
いちご
7.続けて、同様に
以下のテキスト（10行）をコピーして、セルB1の位置にそのまま
貼り付けてください。
NO
1
2
3
4
5
6
7
8
9
8.続けて、もう一つこのデータの在りか(存在するシート名)が分かるように、
以下のテキスト（10行）をコピーして、セルC1の位置にそのまま
貼り付けてください。
シート名
[Sheet3]
[Sheet3]
[Sheet3]
[Sheet3]
[Sheet3]
[Sheet3]
[Sheet3]
[Sheet3]
[Sheet3]
9.では、実行します。（今回は、実行前に開いておくシートは何でも
構いません。）
[ツール(T)] → [マクロ(M)] → [マクロ(M)...] → マクロ画面が
出るので、そのまま[実行]をクリック。
10.すると、入力窓のあるポップアップ画面が表示されたと思いますので、
その入力窓に以下の3文字
りんご
と入力して、このポップアップ画面にある[ＯＫ]ボタンをクリック。
――――――――――――――――――――――――――――＋
実行した結果、シートの[Sheet2]に、各シートの”りんご”の行([Sheet1]3個
[Sheet3]3個の計6行)が、正しく表示されていればＯＫです。
今回はこれで終了です。
今日作ったマクロプログラムは次回もこの続きでまた使いますので、大切に
保管しておいてください。（ファイル名 "gogo108.xls" ）
これで「複数のシートから検索すること」のできるマクロが一応できたことに
なりますが、次回は、いよいよこのマクロの完成を目指して最後の仕上げに掛
かります。完成お楽しみに！
―――――――――――――――――――――――――――――――――――
◆次回の予告
―――――――――――――――――――――――――――――――――――
┏━━▼ Lesson 109 --- 「リクエストガンガン特集」 ---
┃
┃ ・複数シートを検索して行の一覧を表示させるマクロ（完成編）
┃
┗━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━▲
―――――――――――――――――――――――――――――――――――
◆編集後記
―――――――――――――――――――――――――――――――――――
今回も最後までお付き合いいただきまして、ありがとうございます。
なんか、まだ８月だというのにめっきり涼しく、というかむしろ寒いぐらにな
ってしまって、オリンピックの終焉とあいまってちょっと物悲しい夏の終わり
を感じる今日この頃です。
今朝、めざましテレビを見ていたら、今年は富士山の登山客が大幅に増えたそ
うで、その理由は、ガソリン高の影響による安近短ブームのほかにも、オリン
ピックに刺激をうけて「自分も何かを達成したい！」という気持ちになって、
富士山頂を目指すという人が増えたからだそうです。
私もそうですが、五輪で活躍した選手達に「勇気をもらった！」という想いの
人は多いと思いますが、がんばっている人の姿を見て「自分も何かに挑戦して
それを成し遂げてみたい！」という気持ちを持たれた方は、今こそぜひ、その
想いでマクロ作りにチャレンジしてみてくださいね。
まぁ、富士山に登るよりは体力的にはずっと楽ですし(!?)、マクロ作りなら、
達成感のみならず仕事の効率化という多大な”実益”をも同時に得ることがで
きますので、富士登山でヘロヘロになりながら達成感だけ味わうより、マクロ
で二重の喜びを味わって欲しい(!!)と思う次第です。
三太郎でした。
―――――――――――――――――――――――――――――――――――
◆筆者プロフィール
―――――――――――――――――――――――――――――――――――
1962年埼玉県生まれ
中央大学卒後、大手情報処理会社に就職し、プログラマー、ＳＥ、プロジェク
トマネージャーなどを経て、ＩＴコンサルタントとして独立し、現在は、主に
エクセルを活用したＩＴシステムの導入指導からシステム開発に至るまで幅広
く行なう、ＩＴ業界歴20年以上の大ベテランです。
その一方で、ＩＴ教育、人材育成にも力を入れ、富士通のＳＥ育成研修メイン
講師、中小企業大学のＣ言語実習講師、ＣＳＫの研修講師などを歴任するＩＴ
教育者の一人でもあります。ＩＴ業界の各方面に散らばる教え子の数は、かれ
これもうざっと６百人近くに達しています。訪れた客先やセミナーで「あら、
先生っ！」なんて教え子に声を掛けられることもしばしばです。^^;
◆◆◆◆◆◆◆◆◆◆◆◆◆◆◆◆◆◆◆◆◆◆◆◆◆◆◆◆◆◆◆◆◆◆◆
このメルマガ講座「Go! Go! エクセルマクロをはじめよう！」
のご登録(無料)は、こちらから
■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■
戻る