ExcelVBAで電卓を作ろう-その2「アルゴリズムを考える」

今日は、「ExcelVBAで電卓を作ろう」の2回目です。

なお、1回目は、複数のコントロールのイベントを一つのプロシージャにまとめる(ExcelVBA)です。
（タイトルが全然違ってます。すみません）


さて、今回は、どういう方法で電卓の機能をプログラムするかを一緒に考えてみましょう。


これは、非常に重要です。
例えば、「1+1= 」と電卓のボタンを押すと、答の2が画面に表示されなければなりません。
そのためには、どうすればいいのかを考えましょう。

まず、押したボタンの情報をきちんと記憶しておくことが重要です。
どのボタンを押しても、そのボタンの情報をきちんと記憶させておくためには、変数を活用します。

具体的には、「1」「+」「1」「=」の4つのボタンを押していますから、この4つの情報を記憶させる変数が必要です。

それでは、変数は、4つ必要でしょうか？
もし、「1+2-3=」 という計算をしたい場合は、全部で6個の変数が必要ということでしょうか？

すると、長い計算をする場合は、その分変数が必要となります。

なんだか、大変な話になってきましたね。


実は、単純な四則演算ならば、用意する変数は3つあれば何とかなります。

そのうちの2つは、数字を格納する変数です。
もうひとつは、加減乗除のどの演算をおこなうかの情報を格納する変数です。

なぜかというと、長い計算でも、常に、「数字」「記号」「数字」　の構造が続くだけだからです。

つまり、「1 + 1」 は、「数字が1」「記号が+」「数字が1」という構造です。

それでは、「1 + 2 - 3 =」は、どうでしょうか？

まず、「1 + 2」は、「数字が1」「記号が+」「数字が2」ということですから、上記の構造になっています。
その後ですが、「1 + 2」は、3 のことですから、「3 - 3」ということになります。
すると、やはり上記の構造となりますね。

長い計算式は、このように最初から順に計算していくことによって、
常に、「数字」「記号」「数字」　の構造になるのです。


この構造に対応する変数は、3つあればいいことになります。
（補足しておきますが「=」の記号も記号用の変数に格納することになります。）


数字を格納する変数は、好きな名前で結構ですが、今回は、配列を使ってみます。
stack(0) と　stack(1) という名前にしてみました。

スタックというのは、アルゴリズムのテキストを見れば必ず出てくるデータ構造の名前です。
「先入れ後出し」　が特徴です。詳しいことは、各自調べてみてください。

計算の処理は、実は、スタック構造なのです。

なお、この配列変数は、まず最初にstack(0) に値を代入し、次にstack(1)に値を代入するものとします。
この順番は、とても重要です。

そして、もうひとつ重要なことがあります。この配列変数から値を取り出す際には、
必ず後に値を入れたstack(1)のほうから取り出すということです。

イメージとしては、机の上に積み重ねられた本です。

本の上にまた本を積み重ねていきます。これは、データをどんどん入れていく過程です。
本を手に取ろうとすると、どうしても最後に積み重ねた本から取らざるを得ません。
これがデータを取り出す作業です。
まさに、「先入れ後出し」　ですよね。


また、記号を格納する変数は、Action という名前にしてみました。


それでは、「1 + 2 - 3 =」　を例にとって、データの処理の流れを追っていきましょう。
なお、処理の流れを理解しやすくするために、数字は、1桁に限るという制約をもうけます。


まず、仕込みをします。
stack(0) と　stack(1)には、0を入れておきます。
そして、Action には、「+」を格納しておきます。
理由は、こうしておくと、論理がシンプルになるからです。この仕込みは重要です。






電卓の「1」ボタンを押しました。
その際、プログラムサイドでは、stack(1)に1を格納します。




次に「+」ボタンを押します。
プログラムでは、この時点で計算（演算処理）を行います。
つまり、「数字」「記号」「数字」　の構造に以下のように変数の値を適用します。
「stack(0)」「Action」「stack(1)」　

つまり、変数の値で記述すると、
0 + 1
ということになります。
そして、ここが重要ですが、その計算結果である　1 を　stack(0)に格納し、stack(1)を0にします。

何をしているかといいますと、スタックの構造を考えると分かりやすいです。

つまり、計算するために、stackという配列変数からデータを取り出します。
その際、最初に、あとから値を代入したstack(1)　の中から値を取り出し、次に先に入れておいた
stack(0)の値を取り出します。

これが、スタックの特徴の　「先入れ後出し」　です。
一応確認ですが、この時点で、stack配列には、値が何も入っていません。

この2つの値を、Actionに格納されている記号で演算処理し、その計算結果を、再度stackに入れます。
このとき、配列変数は、空っぽですから、stack(0)　に値を入れることになります。
（stack(1)には、まだ値が入っていませんが、それを表現するために0が入っていると考えてください）

そして、今回の記号を　Action の中に格納します。





次に「2」ボタンを押したときの処理です。

2 を配列変数に格納します。既にstack(0)には、値が代入されているので、必然的にstack(1)に格納します。





ここまでで、「1+2」までボタンを押しましたね。もう一息です。

次に「-」ボタンを押したときの処理です。

記号のボタンなので、計算をします。

先程説明した通りの処理を行います。

つまり、stack(1)の値を最初に取り出し、次にstack(0)の値を取り出します。
そして、Actionの中に格納されている「+」を使って演算します。
その答えである 3 を、stack変数に入れます。そうです。stack(0)に　3 が入りますね。
stack(1)は、空っぽなので、0　が入っています。

そして、Action に今回の記号である「-」を格納しておきます。





次に「3」ボタンを押したときの処理です。

stack(1)に　3 を入れます。





いよいよ最後のボタンです。

「=」ボタンを押したときの処理です。

これも、記号ボタンの処理と同じですよ。

つまり、stack(1)の値を最初に取り出し、次にstack(0)の値を取り出します。
そして、Actionの中に格納されている「-」を使って演算します。
stack(0)の値　マイナス　stack(1)の値　ですから、答は、0 となります。

その答えである 0 を、stack変数に入れます。そうです。stack(0)に　3 が入りますね。
stack(1)は、空っぽなので、0　が入っています。

そして、Action には、「=」を代入しておきます。







「1 + 2 - 3 =」という、たったこれだけの計算なのに、その処理を追っていくと、こんなにも長い説明に
なってしまいました。

でも、これで考え方は整理できましたね。

次回は、コードを記述しましょう。それでは、また。


だい

10進数の値を2進数に変換する(Excei2000以降)

今日は、10進数の値を2進数に変換するプログラムを作ります。

ExcelVBAを使います。

サンプルとして、以下のようなワークシートを用意します。

A1に入力した10進数の値に対して、2進数に変換した値をA4に表示してみます。




なお、10進数の値を2進数に変換する方法ですが、
10進数を2で割って、その商をさらに2で割る、 またその商を2で割って…と、余りを出しながら商が0になるまで繰り返します。
その後に、最後の余りを先頭に下から順に並べると2進数になります。

この処理をプログラムで表現することが今回の目的です。

もちろん、繰り返し処理を使いますが、こんなときは再帰呼び出しというアルゴリズムを使うと身近なコードで記述できます。

VisualBasicEditorを起動したら、標準モジュールを挿入してください。

そこに、以下の様に記述します。



Private Sub ConvertValue(ByVal n As Currency, _
　　　　　　　　　　　　ByVal a As Integer, _
　　　　　　　　　　　　ByRef ans As String)
　　'再帰を活用

　　If Int(n / a) = 0 Then
　　　　ans = ans & (n Mod a)
　　　　Exit Sub
　　End If

　　ConvertValue Int(n / a), a, ans
　　ans = ans & (n Mod a)
End Sub

Sub ConvertBinary()
　　'10進数の値を2進数に変換
　　Dim ans As String
　　ConvertValue Range("A1").Value, 2, ans
　　Range("A4").Value = "'" & ans
End Sub

一応画像も載せておきます。





今回は、2つのプロシージャを記述しました。
つまり、2進数に変換する処理をサブルーチン（ConvertValue）として独立させました。
このサブルーチンをメインのプロシージャから呼出します。

このサブルーチン（ConvertValue）には、3つの引数があります。
一つ目は、10進数の値を指定する引数です。
二つ目は、変換する進数の値を指定する引数です（今回は、2となります）
三つ目は、答を格納する引数です。
なお、三つ目は、参照渡し（ByRef指定)してあることに注意しましょう。こうしないと、値を維持することができません。

再帰処理は、繰り返し処理です。
したがって、繰り返しの終了条件を記述しないと、無限ループに陥ります。
今回は、10進数の値を2で割った答えが０になると処理を終了します。
そうでない間は、繰り返し割り算の答えを2で割り続けます。

メインのプロシージャでは、サブルーチンに引数を与えて呼び出しているだけです。



それでは、実行してみます。
今回は、ボタンにマクロ「ConvertBinary」を登録しておきました。

値に10000 を指定して実行してみましょう。
A1に10000と入力して、ボタンを押します。

すると、2進数「10011100010000」が得られました。




今回のサブルーチンの第2引数に、たとえば3と指定すると、3進数に変換できますよ。

それでは、また。


だい

ワークシート上でイラストを動かしてみる(Excel2007)

今日は、お遊びです。

エクセルにクリップアートを一つ配置します。お好きな絵を選んでください。

あとは、以下のコードを、標準モジュールに記述します。


Sub MovePic()
　　Dim i As Integer
　　Dim c As Integer
　　'繰り返し回数の指定
　　Const MAX As Integer = 5

　　c = 1
　　On Error GoTo eh

　　ActiveSheet.Shapes(0).Top = c
　　'図形の削除等の際のエラーのトラップ

　　Do
　　　　'左→右
　　　　For i = 1 To Application.Width Step 2
　　　　　　ActiveSheet.Shapes(0).Left = i
　　　　　　DoEvents
　　　　Next
　　　　ActiveSheet.Shapes(0).Top = _
　　　　　　c * ActiveSheet.Shapes(0).Height
　　　　'右←左
　　　　For i = Application.Width To 1 Step -2
　　　　　　ActiveSheet.Shapes(0).Left = i
　　　　　　DoEvents
　　　　Next
　　　　If c = MAX Then Exit Do
　　　　c = c + 1
　　Loop
　　Exit Sub
eh:
　　MsgBox "終了します"
End Sub

一応画像も載せておきます。




それでは、エクセルに切り替えて、マクロを実行してみましょう。
絵が、画面を左右に行ったり来たりしますよ。




サンプルファイルは、こちらからダウンロードできます。
パスワードは、3024です。

サンプルファイル

それでは、また。


だい

込み入った入力規則を設定する(Excel2003以降）

今日は、生徒さんからの質問を取り上げます。

生徒さんは、どうやら出勤表を作っているようです。



今は、3月までしか作っていませんが、12月まで作りたいそうです。

さて、生徒さんの要望は、次の通りです。

1.出欠の列（B列、D列、F列・・・）には、空白か、「欠」「有給」という文字か、または数字だけを入力したい。

2.もしかしたら、上記2つの文字（「欠」「有給」）以外に、さらに指定文字が増えるかもしれない。

なるほど、出欠の列には、休んだ時の「欠」や「有給」を入力したり、出勤したときの出勤時間
（例えば8時間を意味する8)を入力したりしたいんでしょうね。

こんなとき、どうしたらいいのでしょうか？

エクセルの機能を使うとしたら、「入力規則」になりそうですね。でも、条件指定が、すこしばかりややこしいので、
戸惑いますよね。

VBAは、どうでしょうか？こんな要望に応えることができるのでしょうか？

結論から申し上げますと、「入力規則」でも、VBAでも、どちらでもできるのです。

今回は、VBAを取り上げます。（「入力規則」は、またの機会にご紹介します）



なお、今回の表は、「出欠表」というシートに書かれているとします。

それでは、Altキーを押しながらF11キーを押してください。VisualBasicEditorが起動します。


画面左のプロジェクトエクスプローラの中の「Sheet1(出欠表)」をダブルクリックしてください。
すると、画面右に、「Sheet1(出欠表)」のコードウィンドウが表示されます。
※いつもは、標準モジュールを追加挿入してコーディングしますが、今回は、違いますのでご注意を。





このコードウィンドウ内には、Sheet1のイベントに対応したプロシージャを記述することができます。

つまり、今回は、Sheet1のセルの値が書き換わったときに、上記の条件に沿ってルール違反がないかどうかを
チェックするわけです。

この「Sheet1のセルの値が書き換わったとき」というのが、いわゆるイベントと呼ばれるものです。
このイベントは、あらかじめ用意されているので、該当するイベントを選択して、そのイベント内にコーディングします。

今回は、Worksheetの値がChangeしたとき、というイベントを選択して、コードを書きます。

以下のように、まず、左側のWorksheet を選択して、次に、右側のChangeイベントを選択してください。





自動的に
Private Sub Worksheet_Change(ByVal Target As Range)

End Sub

が、表示されますので、この中に以下を参考にコードを書いてください。（解説もつけておきました。）




Option Explicit

'最終行を定数で指定
Private Const LAST_ROW As Integer = 32

Private Sub Worksheet_Change(ByVal Target As Range)
　　'B列、D列、F列に関して、数値もしくは、「欠」「有給」のみ入力OK
　　'今回は、ルール違反は、メッセージを表示して注意を喚起

　　'最終列を取得
　　Dim LastColumn As Integer
　　LastColumn = Range("A1").End(xlToRight).Column

　　With Target
　　　　'データの最終行以降なら処理を打ち切り
　　　　If .Row > LAST_ROW Then Exit Sub

　　　　'データの最終列以降なら処理を打ち切り
　　　　If .Column > LastColumn Then Exit Sub

　　　　'変更後の値が空白なら、処理打ち切り
　　　　If .Value = "" Then Exit Sub

　　　　'ルール違反かどうかの判定用フラグを用意
　　　　Dim IsOK As Boolean
　　　　IsOK = False
　　　　'偶数列ならば（列番号が2で割り切れるならば）
　　　　If .Column Mod 2 = 0 Then
　　　　　　'入力された値が数値ならば、ルールOK
　　　　　　If IsNumeric(.Value) Then
　　　　　　　　IsOK = True
　　　　　　End If
　　　　　　'入力された値が、指定された文字ならルールOK
　　　　　　If (.Value = "欠") Or (.Value = "有給") Then
　　　　　　　　IsOK = True
　　　　　　End If

　　　　　　'フラグがFalseならば、ルール違反
　　　　　　If IsOK = False Then
　　　　　　　　MsgBox "ルール違反です", vbExclamation, "注意！"
　　　　　　　　.Select
　　　　　　End If

　　　　End If
　　End With
End Sub

画像も載せておきます。




このイベントは、とにかくそれがどのセルであろうと、値が書き換わると発生します。
従って、プログラム内で、そのセルが、今回の対象の行や列のセルかどうかをチェックする必要があります。

あとは、値が数値かどうかのチェック（IsNumeric関数を使います）と、指定された文字かどうかのチェックを行います。

その結果によって、判定用の変数にTrue か　False　が格納されます。
（こうした判定用の変数をフラグと呼びます。旗のことですね。）


それでは、さっそく、エクセルに切り替えて入力してみましょう。

数値は問題なく入力できます。さあ、「欠席」という文字を入力してみました。





これは、ルール違反なので、メッセージボックスが表示されます。





「欠」という文字に修正すると、今度は、問題なく入力できました。






さて、実はまだもう一つの課題が残されています。
「欠」「有給」以外に、さらに指定文字が増えた場合はどうするか、という問題です。
コードの中の指定文字のチェックの条件分岐の部分をそのつど修正すれば、確かに対応できますが、
論理式の部分が、どんどん長くなっていってしまいます。
それに、あまりスマートとは言えません。
工夫の余地がありそうです。

それは、また次回に取り上げましょう。


だい

スペース区切りのデータの各値をセルに展開する

さあ、今日はいい天気だなあ。
こんな日は、みんなもバシバシ、パソコンはかどってるだろうなあ。

空を見て、そんなことを思っていると、生徒さんがやってきました。

「先生、こんなミッションが上司から・・・」

「どんなミッションなんですか？ふむふむ、エクセルですね。」

「そうです。あるシステムから出力された数字の羅列があるのですが、
その数字をひとつずつセルに入れてほしいって言われたんです。」

「ははあ、スペースで区切られた数字の集合体ですね。」

見せてもらうと、こんな感じでした。




「確認したいのですが、上司の指示は、こういうことでいいのでしょうか？」

僕は、手入力で数字を入力して、生徒さんに見せました。





「そうなんです。先生。同じ行のC列から右方向にひとつずつ数字を入れていくんです。
でも先生・・・」

「どうしましたか？」

「手入力なら、僕でもできるのですよ。もっと簡単にできませんか？
今回のサンプルは、たった4行ですが、実際は、1000行くらいあるんですよ。」

「それは、手入力では大変ですね。分かりました。困ったときのVBAといいます。
プログラミングで、乗り切りましょう。」


そんなわけで、今回もエクセルVBAを駆使して、解決することになりました。

なお、今回の条件を整理しておくと、
スペースで区切られた数字は、いつも6個
スペースは、半角だけど、1個のときも2個のときもある。
今回のサンプルは4件だが、実際は何件あるか分からない。



プログラミングの際に、まず考えることは、何が処理の核心かということです。
それが分かると、そのために必要な情報は何かということも分かります。
そして、処理の結果をどうしたらいいのかを考えればいいのです。

少しだけ専門的な表現を使うと、入力→処理→出力　という一連の流れを押さえることが重要なのです。

今回の場合、核心の処理は、「スペース区切りのデータを各数値に分解する」ということです。

そのために必要な情報は、スペース区切りのデータ1件分です。
1件のデータをちゃんと分解できれば、後は、その作業の繰り返しに過ぎないからです。

この核心の処理は、ひとつのプロシージャとして記述します。
そのほうが効率的だからです。

なお、引数にデータ1件分を指定するのがミソです。

以下のようにコーディングします。

Private Sub SplitData(ByVal s As String, ByVal r As Integer)
　　'引数sを空白で分割して、各数字をセルに代入
　　'引数rは、セルの行番号

　　Dim Data As String
　　'行頭行末のスペースを削除
　　Data = Trim(s)
　　'スペースの数を一つに統一（置換を使う）
　　Data = Replace(Data, " ", " ")
　　Dim tmp() As String
　　'Split関数を使ってスペース区切りで値を配列に格納
　　tmp = Split(Data, " ")

　　Dim i As Integer
　　'配列の要素数だけ繰り返し
　　For i = 0 To UBound(tmp)
　　　　'配列のi番目の値をセルに代入
　　　　Cells(r, i + 3).Value = tmp(i)
　　Next

End Sub


参考までに、画像を載せておきます。





メインは、Split関数の部分です。この関数は、戻り値を配列として返します。
配列の個数は今回は必ず6個ですが、いくつか分からないとしても何とかなります。
それが、今回の　UBound(tmp)　の部分です。
配列の上限をこれで取得できるのです。
（ちなみに、VB.NET以降は、tmp.Length という書き方をします。）

なお、スペースの数を1つに統一するのに、いわゆる置換の関数を使うと楽です。
また、行頭のスペースを、Trim関数で削除しておくと、配列の最初の要素から数字を取り込むことができます。


あとは、このサブルーチンを使って1行ずつ処理を繰り返します。

以下のようにコーディングしてください。

Public Sub Main()
　　'1行目から最終行までのデータを繰り返し処理

　　Dim i As Integer
　　Dim LastRow As Integer
　　LastRow = Range("A65536").End(xlUp).Row

　　For i = 1 To LastRow
　　　　'1行ごとにサブルーチンを呼び出す
　　　　Call SplitData(Range("A" & i).Value, i)
　　Next
End Sub

画像は以下のとおりです。





最終行を取得する方法を覚えておくと便利ですよ。


実行すると、以下のとおりになります。





生徒さんも、うまくいきました。今日もがんばりましょう。


だい

組み合わせをすべて表示する-再帰呼出し-

今日は、組み合わせを取り上げます。

1から5までの数字を使って5ケタの数字を作ります。
例えば、12345 という感じですね。

さあ、全部でどのくらいの数字を作れるのでしょうか？

11111
11112
11113
11114
11115
11121
11122
11123
11124
11125
11131

という具合に、順番にきちんと考えていくと分かりますね。
分かりやすくするために、左から1ケタ2ケタと呼びます。
1ケタ目は全部で5通りあります。
2ケタ目も5通りあります。
3ケタ目も5通りありますね。

そうです。
5*5*5*5*5=3125　通りあるのです。

さあ、エクセルでこの組み合わせを全部表示してみましょう。


プログラムでは、こういう場合、配列を使います。

5ケタなので、要素数が5の配列を用意します。
左の要素から順番に0,1,2,3,4というインデックス（添え字）がつきます。

この各要素に1から5までの数字が入るのです。


繰り返し処理ということは分かりますね。
でも、5ケタあるので、繰り返しを5回入れ子にしなければなりません。
これは、大変なことです。
まあ、5回なら何とかなりますが、もし、これが10ケタだったら、えらいことです。
桁数が増えるごとに、コードも変更しなければなりません。
もっと、楽にコーディングできないものでしょうか。

実は、楽にコードを書く方法があるのです。
「再帰呼出し」という手法を使うのです。
最初は、とっつきにくいのですが、コードのシンプルさにきっと感動するでしょう。


VBエディターを起動したら、次のように記述します。

'配列の宣言
Private Combi(5) As Integer

Private Sub Permutation(n As Integer)
　　'引数は桁
　　Dim i As Integer

　　For i = 0 To 4
　　　　Combi(n) = i + 1
　　　　If n = 5 Then
　　　　　　'5けたになると書き出し
　　　　　　OutPut
　　　　Else
　　　　　　'ここで再帰呼出し
　　　　　　Permutation (n + 1)
　　　　End If
　　Next
End Sub




このPermutationというプロシージャが今回のキモです。
引数に桁数を指定します。
5ケタになるまで、自分自身の関数を呼び出します。
こんな書き方が許されるんですね。

なお、コードの中の　OutPut　というのは、サブルーチンです。
つぎのように書いてください。

Private Sub OutPut()
　　'書き出しのサブルーチン
　　Dim i As Integer
　　Dim c As String
　　c = 0
　　For i = 1 To 5
　　　　c = c & Combi(i)
　　Next
　　Dim TenkiRow As Long
　　TenkiRow = Range("A65536").End(xlUp).Offset(1).Row
　　Cells(TenkiRow, 1).Value = c

End Sub




これは、難しくありません。
ただ、セルに配列の値を書き出しているだけですね。

さあ、以上のサブルーチンを使うメインのプロシージャを記述します。

Sub main()
    'サブルーチンを呼ぶ
    Permutation (1)
End Sub

なんと、1行だけのコードでした。

さあ、マクロを実行します。

しっかりと書き出されましたね。





だい

省略されたデータを取得するオリジナル関数

こんな質問を受けました。

「こんな表があるんです。A列の値が同じ場合は、省略されているのです。
その省略されているA列の値を調べるには、どうすればいいんですか？」

その表とは、こんな表です。




確かに、手書きでは、こんな風に書きますよね。

でも、エクセルで管理するには、A列の値を省略することはお勧めできません。
くどいようでも、同じ値を入力する必要があります。

それでも、どうしても、省略しろという上司の命令があるのなら、仕方がないですね。


こんな場合、例えば、4列目をどこかに転記する必要があるとき、A列の値は、空欄というわけにはいきません。

なんとかして、A列の値を求めなければなりませんね。

こんな感じです。





さあ、どうしましょうか？

VBAで、オリジナルの関数を、つまり、ユーザー定義関数をつくってみましょう。


エクセルを起動したら、Altキーを押しながらF11キーを押します。
すると、Visual Basic Editorが起動します。

コードを記述するモジュールが必要なので、「挿入」→「標準モジュール」とクリックします。

そこに、以下のようにコードを記述します。

Function GetMeisho(r As Range) As String
    If r.Offset(, -1).Value = "" Then
        GetMeisho = r.Offset(, -1).End(xlUp).Value
    Else
        GetMeisho = r.Offset(, -1).Value
    End If
End Function

画像も載せておきます。



解説です。
引数にB列のセルを指定し、そのセルの左隣（つまりA列）の値を取得します。
もし空欄なら、どんどん上を見に行って、値が出てきたらそれが、該当するA列の名称の値となります。




ユーザー定義関数は、VBAの中でも使用できますが、標準のワークシート関数のように、エクセルで使用することもできます。

今回は、E列にこの関数を設定します。
E列2行目に、関数を入力します。引数は、B2　を指定してください。
あとは、オートフィルで大丈夫です。



なお、注意事項があります。
関数は、引数が変更されると自動的に再計算されますが、引数以外のセルの値の変更時には再計算されません。
したがって、E列に関数を設定した後、A列の値を変更しても、答えは正しく更新されません。
再度、E列に関数を入力しなおしてください。



だい

テーブルタグ自動生成システムをつくろう(Excel2002以降）

おはようございます。

仕事柄、Webページを制作します。

市販のソフトは使わずに、htmlを手入力して制作しております。
めんどくさいのは、表の作成です。そう、タグです。
もちろん、レイアウトのために使うのではありません。
純然たる表ですよ。

以下の図のようなHTMLです。

テーブルの構造は、規則的ですね。




そこで、Excelの表を使って、HTMLを自動生成するプログラムを作ってしまおうというのが、今日の課題です。



さて、Excelで表を作るのは、簡単ですよね。

以下の図は、例です。






Excelで作成した表の全部をHTMLにしてもいいのですが、自由度を増すために、あらかじめ選択した範囲をHTMLにしてみます。

こんなときは、ユーザー定義関数を作成するのがおすすめです。

以下のように書いてみましょう。

Private Function CreateTable(Rng As Range) As String
    '引数で指定したセル範囲をテーブルにする
    
    '引数のセル範囲の行数と列数を取得
    Dim r As Integer, c As Integer
    r = Rng.Rows.Count
    c = Rng.Columns.Count
    
    '引数のセル範囲の開始行と開始列を取得
    Dim startRow As Integer
    Dim startColumn As Integer
    startRow = Rng.Range("A1").Row
    startColumn = Rng.Range("A1").Column
    
    '変数sに、生成したHTMLを格納
    Dim s As String
    s = "

" & vbNewLine Dim i As Integer, j As Integer For i = startRow To startRow + r - 1 '行の始めは s = s & "" '列数分、セルの値をで囲む For j = startColumn To startColumn + c - 1 s = s & "" Next '行の終わりは s = s & "" & vbNewLine Next s = s & "

	" s = s & Cells(i, j).Value s = s & "

" CreateTable = s '関数の戻り値にsを指定 End Function


繰り返し処理をうまく使いましょう。

一応、画像も載せておきます。




それでは、作った関数を使ってHTMLを書き出しましょう。

せっかくですから、テキストファイルに書き出して保存できるようにします。

そうすれば、あとで自由に使用することができますね。

以下のコードを書いてください。

Sub main()

    Dim fName As String

    '保存用ダイアログボックスを表示

    fName = Application.GetSaveAsFilename("table.txt","テキストファイル(*.txt),*.txt",,"テキストファイルの保存")

    'キャンセルボタンが押されたら、終了

    If fName = "False" Then Exit Sub

    

    'ファイルに書き込み

    Open fName For Append As #1

        'ここで、作成した関数を使用

        Print #1, CreateTable(Selection)

    Close #1

End Sub

画像は、下です。




ExcelVBAには、開くためのダイアログボックスと保存するためのダイアログボックスが用意されています。
これを使います。

また、ファイル処理には、独特のステートメント（構文）を使います。
（親分のVB.NET は、もっとシンプルで楽な構文に変わりましたけど・・・）

それでは実行してみましょう。

まず、表の任意の部分を選択してください。この選択範囲が、HTML化されます。
それでは、マクロを実行します。




保存先の選択ダイアログボックスが表示されます。
任意の保存先を指定し、ファイル名を自由に指定してください。
（キャンセルすると、保存されません。）




あっという間に、保存されますよ。

保存されたテキストファイルを開いてみましょう。
ちゃんと、HTMLが生成されているのが分かります。




エクセルって、こんなときにも役に立つんですね。



だい

エクセルファイル（ブック）間のデータの転記処理(Excel2002以降)

今回は、前回の記事の続きです。

前回の記事「任意のフォルダ内のファイルをすべて取得する方法」はこちらです。

今回の目的は、
「指定したフォルダ内のすべてのエクセルファイルから、ある値を抜き出して、
集計表を作成する」というものです。

指定したフォルダ内には、いくつのエクセルファイルがあろうと構いません。
ただし、コードを分かりやすくするために、エクセルファイルだけが存在するものとします。

また、今回のコード(ExcelVBA)を記述するファイルに、集計表を作成するものとします。


例として、以下のような集計表を作成します。お客様の購入額集計表ですね。




誰がどのくらい購入したかは、別のエクセルファイル（ブック）で管理されているものとします。
そのファイルは、お客様ごとに別々のファイルで管理されています。



例えば、横山さんのファイルを開くと、以下のような表があるとします。






C列2行目に、お客様の氏名が、　C列15行目に購入金額の合計額がそれぞれありますね。

この値を、集計表に転記するのが、今回の目的です。

つまり、フォルダ内に存在するエクセルファイル全てについて、C列2行目の値とC列15行目の値をコピーして
集計表に貼り付ければいいわけです。


さて、エクセルファイルの保存されているフォルダについて、今回は、以下のような設定で話を進めます。

もちろん、どのフォルダであろうと、ちゃんと動くプログラムを作りますからね。


Cドライブの直下に「ブック間の処理」というフォルダがあるとします。（べたな名前で済みません。。。）

その中に、「集計ファイル」というブックがありますね。これが、集計表のあるエクセルファイルという設定です。
したがって、今回は、この集計ファイルを開いて、そこにExcelVBAを記述するわけですよ。





よく見ると、「購入記録」というフォルダがありますね。

そうです。その中に、顧客ごとの購入情報が入力されたエクセルファイルが保存されているわけです。

今回は、分かりやすくするために、ファイル数は3つと少なめですが、多くても大丈夫ですよ。



また、ファイル名は、顧客名ではありませんね。別にどんなファイル名でも今回は構いませんよ。


それでは、集計ファイルを開いて、さっそくコーディングしましょう。


エクセルを起動したら、Altキーを押しながらF11キーを押します。
すると、Visual Basic Editorが起動します。

コードを記述するモジュールが必要なので、「挿入」→「標準モジュール」とクリックします。






これで、用意ができました。

今回もまた、ファイル操作を扱うので、「ファイルシステムオブジェクト」を使います。

この機能は、初期設定では使用できるようになっていませんのでご注意を。

次のようにして、使えるようにしてくださいね。

「ツール」→「参照設定」とクリックします。





参照設定ダイアログボックスが表示されたら、一覧を下にスクロールして、「Microsoft Scripting Runtime」に
チェックを入れてください。

そして、OKボタンを押します。

これで、「ファイルシステムオブジェクト」を使用する準備ができました。

この作業が大切ですので、忘れずにお願いします。






それでは、コードを記述しましょう。

まず、サブルーチンからです。引数つきですよ。

Private Sub GetData(ByVal FolderPath As String)
    '引数付のサブルーチン
    '引数は、フォルダーのパス
    Dim FSO As New FileSystemObject
    Dim Files As Files
    Dim File As File
    Dim FileName As String
    Dim TenkiRow As Integer
    
    '引数のパス内のファイル一覧を取得
    Set Files = FSO.GetFolder(FolderPath).Files
    For Each File In Files
        'フルパスを取得
        FileName = FolderPath & "" & File.Name
        'ファイルを開く
        Workbooks.Open FileName
        
        With ThisWorkbook.Worksheets(1)
            '転記先の行を取得
            TenkiRow = .Range("B65536").End(xlUp).Offset(1).Row
            '転記作業
            .Range("B" & TenkiRow).Value = _
                ActiveWorkbook.Worksheets(1).Range("C2").Value
            .Range("C" & TenkiRow).Value = _
                ActiveWorkbook.Worksheets(1).Range("C15").Value
        End With
        'ファイルを閉じる
        ActiveWorkbook.Close False
    Next
End Sub

画像も載せておきます。




処理の概要は、前回と同様ですね。

For Each ～ Next構文の繰り返し処理を使って、
指定したフォルダ内のファイルをひとつずつ開いては、
C2とc15の値を、集計ファイルの最終行の直下に転記していきます。
今回は、コピーメソッドを使わずに、値の代入方式を採用しました。
なお、コードを書いている等のファイル（集計ファイル.xls）は、
ThisWorkbook というオブジェクトで参照できるんですよ。
そうそう、転記後、閉じることを忘れずに。


もうひとつ、このサブルーチンを呼び出すプロシージャを作る必要があります。

以下のようにコーディングしてください。

Sub ファイルの取得()

    'サブルーチンを使って、

    '指定フォルダ内のファイルの値を転記する

    

    Dim MyPath As String

    

    '変数に、フォルダのパスを代入

    MyPath = "C:ブック間の処理購入記録"

    

    'サブルーチンの呼び出し

    GetData MyPath

    

End Sub

サブルーチンを呼び出す際に、フォルダのパスをお忘れなく。（エラーになりますよ）



画像はこちら。





それでは、エクセルに切り替えて、実行してみましょう。

Altキーを押しながらF8キーを押します。

マクロダイアログボックスが表示されます。

実行ボタンを押します。





ファイルが開かれたり閉じたりと素早く画面が移り変わりますが、少し待つと、
値が代入された購入表が現れて終了します。





このような処理が必要になる場面は、実務では、意外と多いのではないでしょうか？

参考になれば、幸いです。



だい暑い

任意のフォルダ内のファイルをすべて取得する方法(Excel2002以降)

今日は、クライアントさんからの質問を取り上げます。

その質問とは、
「あるフォルダの中にあるファイル名を全部取得したいのですが、
エクセルで、そんな事は出来ますか？」
というものです。

エクセルの上で動作しているVBAというプログラミング言語は、なかなか立派なものです。

エクセル特有の操作はもちろん、エクセルに関係ないような機能もカバーしています。

今回のような、いわゆるファイル操作に関しても、ちゃんと対応しているのです。


例として、パス（ファイルやフォルダのコンピュータ内での住所のこと）を
Iドライブの「ワード資料」というフォルダということにして、そのフォルダ内のファイル一覧を取得してみます。

ちなみに、上記のパスは、「I:\ワード資料」　と書きます。


それでは、さっそく、VBAでコーディングしてみましょう。


エクセルを起動したら、Altキーを押しながらF11キーを押します。
すると、Visual Basic Editorが起動します。

コードを記述するモジュールが必要なので、「挿入」→「標準モジュール」とクリックします。






これで、用意ができました。

おっと、大事なことを忘れていました。
今回のように、ファイル操作を扱うときは、「ファイルシステムオブジェクト」を使うと便利です。

ところが、この機能は、初期設定では使用できるようになっていません。

ですから、まず、この機能を使えるようにすることが必要なのです。

具体的には、次のようにします。

「ツール」→「参照設定」とクリックします。





参照設定ダイアログボックスが表示されたら、一覧を下にスクロールして、「Microsoft Scripting Runtime」に
チェックを入れてください。

そして、OKボタンを押します。

これで、「ファイルシステムオブジェクト」を使用する準備ができました。

この作業が大切ですので、忘れずにお願いします。






それでは、コードを記述しましょう。


---------------------------------------------------

Sub ファイルの取得()
    'サブルーチンを使って、
    '指定したフォルダの中のファイル名を取得
    
    Dim MyPath As String
    
    '変数に、フォルダのパスを代入
    MyPath = "I:\ワード資料"
    
　　'サブルーチンの呼び出し
    GetFiles MyPath
    
End Sub

Private Sub GetFiles(FolderPath As String)
    '引数付のサブルーチン
    '引数は、フォルダーのパス
    Dim FSO As New FileSystemObject
    Dim Files As Files
    Dim File As File
    
    'まず、フォルダのパスをA列1行目に書く
    Range("A1").Value = FolderPath
    
    '引数で指定されたフォルダの中のファイル一覧を取得
    Set Files = FSO.GetFolder(FolderPath).Files
    
    'ファイル一覧から順次ファイル名を取得し、A列に書き出す
    For Each File In Files
        Range("A65536").End(xlUp).Offset(1).Value = File.Name
    Next
    
End Sub

---------------------------------------------------

画像も載せておきます。






今回は、サブルーチンを使用してみました。

プログラムの中で、別のプログラムを呼び出すのです。

subで始まるプロシージャが2つあることにお気づきでしょうか。

ひとつのプロシージャがとても長くなってしまうことがあります。

そんなときは、処理のまとまりごとにプロシージャを作成して、それを呼び出します。

そのほうが、分かりやすいし、使い回しがきくものです。ここら辺の感覚は、コードを書いていくと自然と身に付きます。

今回のサブルーチンは、引数（パラメータ）を持っています。

慣れてくると、大変便利な記述法ですよ。

つまり、パスを引数として与えてあげれば、とにかく、そのパスの中のファイル一覧を取得できるのです。

融通がきくんですよ。

書き方としては、プロシージャ名のあとに半角スペースを入れて、パラメータを書きます。シンプルですね。

今回は、引数に　"I:\ワード資料"　というパスを指定していますが、
この部分を自分のパソコンの任意のパスに変更すれば、それだけで、そのパスのファイル一覧を取得することができます。


処理の内容としては、繰り返し処理で、ファイルシステムオブジェクトを使って取得したファイル群を
ひとつずつ取り出して、ファイル名をA列に書き込んでいるのです。



それでは、エクセルに切り替えて、実行してみましょう。

Altキーを押しながらF8キーを押します。

マクロダイアログボックスが表示されます。

実行ボタンを押してみます。




実行すると、シートのA列に、ファイル名が表示されます。

エクセルでも、こんなことができるんですよ。





もし、指定したパスにあるファイルのうち、エクセルファイルだけを取得したければ、

ファイル名の拡張子が、.xls 　という条件を追加すればよいでしょう。

（エクセル2007ファイルも取得したければ、.xlsx も条件に入れてください）


さて、次回は、取得したエクセルファイルを逐一開いて、ある処理をするというケースを取り上げます。
お楽しみに。



だい

グラフの名前を変更する方法(Excel2003以降)

今日もまた生徒さんの質問を取り上げます。

「グラフには、名前があるんですか？」

「いい質問ですね。人に名前があるように、グラフにも名前があるんですよ。」

「誰が名前を付けているんですか？」

「エクセルが自動的に名前を付けています。」

「どんな名前なんですか？」

「それが、まったく没個性的な名前なんですよ。一緒に確認してみましょう。」


てなわけで、まず、グラフを作ってみましょう。

下の画像を例に取り上げます。（Excel2003で説明します。）

シンプルな表ですが、お許しください。





さあ、グラフの名前を確認しましょう。
グラフを選択して、名前ボックスを見てみます。

でも、選択したグラフの要素の名前が表示されていますね。
今回は、グラフエリアを選択したので、グラフエリアと表示されていますね。

これは、グラフの名前ではありません。
でも、グラフの名前は、名前ボックスで確認できるんですよ。

それでは、どうしたら確認できるのでしょうか？





まず、任意のセルを選択してグラフの選択を解除しておきます。

画面左下をご覧ください。
シート名の下に、図形描画ツーバーがあります。
なければ、「表示」→「ツールバー」→「図形描画」をクリックしてください。

「オブジェクトの選択」をクリックします。






改めてグラフを選択します。

すると、名前ボックスに、グラフの名前が表示されます。

「グラフ 2」というのがこのグラフの名前です。なんと安直な名前でしょう。
というか、一応日本語で名前が付いているところが面白いですね。
皆さんの想像の通り、グラフが作成されると、最後の数字が増えていきます。
グラフの名前を見ると、何回目に作成されたかが分かってしまうのですよ。


さて、これで、グラフに名前が付いていることが分かりましたね。







これでおしまいでは、物足りない方のために、この名前を変更する方法をご紹介します。

手動で変更するには、名前ボックスの値を直接変更してください。これでOKです。

それでは、VBAでは、どのように記述するのでしょう？


ALT + F11 で、VisualBasicEditorを起動します。
「挿入」→「標準モジュール」をクリックします。
これで、コードを記述する準備が整いました。

以下のように、標準モジュールに記述してください。ちなみに、今回は、グラフに「2010売上」という名前を付けてみます。

Sub SetGraphName()
    'グラフに名前を付ける
    'グラフのコレクションは、1から始まる
    ActiveSheet.ChartObjects(1).Name = "2010売上"
End Sub

画像も載せておきます。





コードの中で、ChartObjectsという言葉が出てきました。これは、グラフをさす集合体のことです。
括弧の中の数字（インデックスと言います）は、何番目に作られたグラフなのかを意味しています。
今回は、アクティブなシートの中にグラフは一つしかないので、(1)と記述します。
ChartObjects　のインデックスは、1から始まります。0からではありませんのでご注意ください。

それでは、Excelに切り替えてください。
プログラムを実行してみましょう。


Excel2003までは、「ツール」→「マクロ」→「マクロ」とクリックします。
Excel2007は、Altキーを押しながらF8キーを押してください。

今回記述したマクロ（プロシージャ）を選択して、実行ボタンをクリックします。





オブジェクトの選択ボタンがONになっているのを確認して、グラフを選択してください。

ちゃんと、グラフの名前が変更されているのがお分かりいただけます。





このコードを応用すれば、グラフを作成するごとに、グラフに任意の名前を付けることができます。

きちんと名前を付けておけば、そのグラフを特定できるので、あとから、色々な指示を与えることができますね。



だい

Googleの検索結果の総数一覧表を作成する その4(ExcelVBA）

いよいよ、クライマックスです。

過去3回の記事をおさらいしておいてくださいね。
今回の処理の概要は、次のとおりです。

「表の検索キーワードを使って、Googleで検索を行い、検索結果の総数をF列に代入する」
今回の表は、10行ありますので、繰り返し処理を行います。


それでは、プログラムの処理を確認しましょう。

1.表のシート（今回は、「Sheet1」です）の3行目の検索キーワードを含んだURLを生成する
2.エクセルの機能「新しいWebクエリ」を使って、別のシート（今回は、「Sheet2」です）にデータを取り込む
3.取り込んだデータの中から、検索結果の総数を取得して（自作関数を使用）、表のF列3行目に代入する
4.上記1～4の手順を、表の最終行まで、繰り返す（今回は10回）
5.取り込みの際に自動的に生成される　名前　を全部削除する（サブルーチンとして作成しました）


手順5について説明をしておきます。
データを取り込むごとに、名前が自動生成されてしまいます。
これは、増える一方です。





パソコンの性能によりますが、この名前があまり多くなると、とたんに処理が遅くなります。
パソコンによっては、動かなくなることもあります。
それを避けるために、処理の最後に、この名前を全部削除しているのです。

今回は、この処理を独立したプロシージャとしてつくりました。
名前は、DeleteNameとしました。
いくつあるか分からない名前を全部削除するには、For Each ～ Next構文を使うと簡単です。
詳しくは、下のコードをご覧ください。



それでは、標準モジュールに記述するコードを確認します。

3つのプロシージャ（プログラムの単位）がありますよ。

Sub 検索件数の取得()
    Dim qs As String
    Dim i As Integer
    Dim LastRow As Integer
    Sheets(1).Select
    
    '最終行を取得
    LastRow = Range("B65536").End(xlUp).Row
    
    For i = 3 To LastRow
    
        Sheets(1).Select
        '検索キーワードを含んだURLを生成する
        qs = "http://www.google.co.jp/search?hl=ja&source=hp&q="
        qs = qs & Range("C" & i).Value & " "
        qs = qs & Range("D" & i).Value & " "
        qs = qs & Range("E" & i).Value
        qs = qs & "&btnG=Google+%E6%A4%9C%E7%B4%A2&lr=&aq=f&aqi=g8g-r2&aql=&oq=&gs_rfai="
        
        Sheets(2).Cells.Clear
        'データを取り込む（メイン処理）特に2行下のコードに注目。qs がURL　です。
        With Sheets(2).QueryTables.Add(Connection:= _
            "URL;" & qs, Destination:=Sheets(2).Range("A1"))
            .Name = "google"
            .FieldNames = True
            .RowNumbers = False
            .FillAdjacentFormulas = False
            .PreserveFormatting = True
            .RefreshOnFileOpen = False
            .BackgroundQuery = True
            .RefreshStyle = xlInsertDeleteCells
            .SavePassword = False
            .SaveData = True
            .AdjustColumnWidth = True
            .RefreshPeriod = 0
            .WebSelectionType = xlEntirePage
            .WebFormatting = xlWebFormattingNone
            .WebPreFormattedTextToColumns = True
            .WebConsecutiveDelimitersAsOne = True
            .WebSingleBlockTextImport = False
            .WebDisableDateRecognition = False
            .WebDisableRedirections = False
            .Refresh BackgroundQuery:=False
        End With
        
        '取り込んだデータの中から、検索結果の総数を取り出す
        '別途作成した　自作関数を使用する
        Sheets(1).Range("F" & i).Value = GetKensu
    Next
    
    'サブルーチンを実行する
    DeleteName
    
    Sheets(1).Select
End Sub

Function GetKensu() As String
    '自作関数：取り込んだデータから検索結果の総数を取得する
    
    Dim i As Integer
    Dim LastRow As Integer
    Dim StartPoint As Integer, EndPoint As Integer
    '定数に、今回は、「検索結果」を設定する
    Const StartKeyWord As String = "検索結果"
    
    Sheets(2).Select
    '最終行を見つける
    LastRow = Range("A65536").End(xlUp).Row
    
    For i = 1 To LastRow
        '行に、「検索結果」という文字があるかどうかをチェック。
        StartPoint = InStr(Range("A" & i).Value, StartKeyWord)
        If StartPoint > 0 Then
            '見つかった場合の処理（見つかると、行頭からの文字数を返す）
            EndPoint = InStr(Range("A" & i).Value, "件中")
            '「件中」という文字までの間に、検索件数の数字が存在する
            GetKensu = Mid(Range("a" & i).Value, _
                            StartPoint + Len(StartKeyWord), _
                            EndPoint - (StartPoint + Len(StartKeyWord)))
            '「検索結果」と「件中」の間の文字を取得
            GetKensu = Replace(GetKensu, "約", "")
            '「約」という文字を削除（こういう場合に、置換を使用する）
            GetKensu = Trim(GetKensu)
            '一応、数値の両端の空白を除去しておく
            Exit Function
        End If
    Next
    GetKensu = "なし"
    'もし、検索結果の数値が見つからなかった場合の、この関数の答え
End Function

Sub DeleteName()
    Dim n As Name
    
    For Each n In Names
        n.Delete
    Next
    
End Sub

画像を載せておきます。







それでは、プログラムを実行してみましょう。

「ツール」「マクロ」「マクロ」で、「マクロ」ダイアログボックスを表示します。
Altキーを押しながら、F8キーを押してもいいですよ。


検索件数の取得　を選択して、実行ボタンを押してください。







すると、F列に、順次、数字が代入されていきます。
大体、1秒おきくらいのペースで、代入されていきますが、
ネットの通信状況等で、もっと遅くなるかもしれません。
しばらく、眺めていてやってください。


ほら、完了しました。





今回のシリーズは、いくつものステップに分けて、最終的に目的を達成しました。

そのステップごとに、プロシージャをつくり、それを呼び出して処理するようにすると、
プログラム全体の見通しがよくなります。

今回の場合では、繰り返し、データを取り込むプログラムが主となりますが、
その中で、取り込んだデータから検索結果の総数を取得するプログラムまで記述すると、
プログラムが長くなり、分かりにくくなってしまいます。

そこで、取り込んだデータから検索結果の総数を取得する部分を、別途関数として
独立したプロシージャとすることによって、ロジックとしても、処理の流れとしても
可読性の高いプログラムとなります。

同様に、名前の一括削除も、独立させて、呼び出すようにしました。



「困難は、分割せよ」ということわざがあります。

プログラムを作るのにも、たいへん有用な言葉です。

それでは、また。



だい

Googleの検索結果の総数一覧表を作成する その3(ExcelVBA）

今回は、Webページから取得したデータの中から、目的の検索結果の総数を
いかに取り出すかを一緒に考えてみたいと思います。

さて、前回は、左から2番目のシートに、データを取り込んだところまででした。


10行目に、検索結果の総数がありますね。
この数字だけを取り出したいのです。







しかし、毎回10行目にあるとは限らないのです。（確認したら、そうでした）

ですから、取り込んだ全てのデータから、何とか見つけ出すしかないのです。

つまり、1行目から、順番に検索結果の総数の数字があるかどうかをチェックしていけばいいのです。

取り込んだデータをよく見てください。

検索結果の総数は、「検索結果」という文字の後にあるのです。

従って、1行目から、「検索結果」という文字が存在するかどうかをチェックすればいいのです。

こんなときは、Instr という関数を使用します。

そして、存在したら、今度は、その数字の後ろの文字、「件中」までの間の文字を
抜き出せば、数字を取り出すことができそうです。

ただし、数字の前に、約　という文字がありますね。
何度か検索してみたところ、この　約　という文字は、必ずしもあるわけではないことが分かりました。

そんな時は、どうすればいいのでしょう。

約という文字がある場合と、ない場合で、処理を分岐する方法もありますが、
実は、もっと簡単な方法があります。

「置換」という機能を使うのです。

この方法を使うと、条件分岐をする必要がありません。だから、コードがシンプルになります。ありがたいですね。

あとは、求める数字の両端に空白がある場合がありますので、関数を使って除去します。


以上が、処理の流れです。

なお、今回の処理は、必ず答えが出るので、Functionプロシージャとして作ります。
いわゆる、ユーザー定義関数ですね。

関数名は、GetKensu　としました。


コードで記述すると、以下のようになります。

Function GetKensu() As String
    Dim i As Integer
    Dim LastRow As Integer
    Dim StartPoint As Integer, EndPoint As Integer
    '定数に、今回は、「検索結果」を設定する
    Const StartKeyWord As String = "検索結果"
    
    Sheets(2).Select
    '最終行を見つける
    LastRow = Range("A65536").End(xlUp).Row
    
    For i = 1 To LastRow
        '行に、「検索結果」という文字があるかどうかをチェック。
        StartPoint = InStr(Range("A" & i).Value, StartKeyWord)
        If StartPoint > 0 Then
            '見つかった場合の処理（見つかると、行頭からの文字数を返す）
            EndPoint = InStr(Range("A" & i).Value, "件中")
            '「件中」という文字までの間に、検索件数の数字が存在する
            GetKensu = Mid(Range("a" & i).Value, _
                            StartPoint + Len(StartKeyWord), _
                            EndPoint - (StartPoint + Len(StartKeyWord)))
            '「検索結果」と「件中」の間の文字を取得
            GetKensu = Replace(GetKensu, "約", "")
            '「約」という文字を削除（こういう場合に、置換を使用する）
            GetKensu = Trim(GetKensu)
            '一応、数値の両端の空白を除去しておく
            Exit Function
        End If
    Next
    GetKensu = "なし"
    'もし、検索結果の数値が見つからなかった場合の、この関数の答え
End Function

一応、画像も載せておきます。






緑色の部分は、プログラムで実行されない部分、つまり、コメント行です。
ですから、なくてもかまいません。

この関数を実行すると、検索結果の総数を取得することができます。


VBAには、文字列の制御に関する様々な関数が用意されています。
活用しましょうね。


次回は、いよいよ、クライマックスですよ。、お楽しみに♪


だい

Googleの検索結果の総数一覧表を作成する その2(ExcelVBA）

前回の続きです。
詳しくは、Googleの検索結果の総数一覧表を作成する その1(ExcelVBA）をご覧ください。

それでは、いよいよ、「外部データの取り込み」の「新しいWebクエリ」という機能をつかってみましょう。

この機能は、あとで使い回しますので、マクロの記録で、きちんとコード化しておきましょう。

なお、Excel2003での操作方法となりますのでご了承ください。

まず、別のシートを選択しておきます。
今回は、sheet2　を選択します。
次に、A列1行目を選択しておきます。後の作業が楽になります。

それでは、マクロの記録を始めます。



「ツール」「マクロ」「新しいマクロの記録」とクリックします。





「マクロの記録」ダイアログボックスが表示されます。
マクロ名は、後で変更しますので、何でもかまいません。
ただし、マクロの保存先は、「作業中のブック」にしてください。
「OK」を押します。これで、以降の操作は、すべて記録されます。




ここからが、本番です。
「データ」「外部データの取り込み」「新しいWebクエリ」とクリックします。





「新しいWebクエリ」ダイアログボックスが表示されます。
この中に、どこかのWebサイトが表示されていますね。
どのWebサイトが表示されていてもかまいませんよ。





アドレス欄に、www.google.co.jp と正しく入力して、「移動」ボタンをクリックしてください。
グーグルのサイトが表示されれば、うまくいっていますよ。






Googleの検索窓に、「上田市　ラーメン」と入力して、「Google検索」ボタンをクリックします。






検索結果が表示されるので、サイトの左上の黄色い矢印をクリックします。

黄色い矢印にマウスをあわせると、グレーの枠が表示されます。
この枠の中の情報をエクセルに引っ張ってくることができます。

今回は、検索結果の数字を引っ張って来たいのですが、左上の矢印しか、
検索結果の数字を含まないので、この矢印をクリックしました。

次に、ダイアログボックス下部の「取り込み」ボタンをクリックします。




「データのインポート」画面に切り替わります。
あらかじめA列1行目を選択しておいたので、このまま「OK」ボタンをクリックします。

（この画面で、A列1行目を指定してもかまいません）





Web上のデータが、エクセルに取り込まれます。
今回は、10行目に注目して下さい。
ここに、僕らの目的である検索結果の数字がありますね。
この数字を取り込みたかったのです。（つまり、後のデータは、不要なんですね。）

それでは、ここで、「記録の終了」ボタンをクリックします。（四角いボタンですよ）





Alt + F11　で、Visual Basic Editorに切り替えます。

以下のようなコードが、記述されます。

Sub Macro1()
'
' Macro1 Macro
' マクロ記録日 : 2010/4/23  ユーザー名 : ｔatsudai
'

'
    With ActiveSheet.QueryTables.Add(Connection:= _
        "URL;http://www.google.co.jp/search?hl=ja&source=hp&q=%E4%B8%8A%E7%94%B0%
E5%B8%82%E3%80%80%E3%83%A9%E3%83%BC%E3%83%A1%E3%83%B3
&btnG=Google+%E6%A4%9C%E7%B4%A2&lr=&aq=f&aqi=g3g-c1g3g-r1&aql=&oq=&gs_rfai="
(紙面の都合上、改行しましたが、実際は1行です)
        , Destination:=Range("A1"))
        .Name = _
        "search?hl=ja&source=hp&q=%E4%B8%8A%(割愛)&oq=&gs_rfai="
        .FieldNames = True
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .BackgroundQuery = True
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .WebSelectionType = xlEntirePage
        .WebFormatting = xlWebFormattingNone
        .WebPreFormattedTextToColumns = True
        .WebConsecutiveDelimitersAsOne = True
        .WebSingleBlockTextImport = False
        .WebDisableDateRecognition = False
        .WebDisableRedirections = False
        .Refresh BackgroundQuery:=False
    End With
End Sub

一応画像も載せておきます。





今回のコードの中で、赤線を引いた部分が、検索に関する部分です。

この部分を、逐次　別のキーワードに置き換えることができれば、
このマクロ（プロシージャ）は、かなり使い物になります。

その方法は、やがてちゃんと取り上げます。

さて、次回は、その前に、取り込んだデータの中から、
どうやって、検索結果の数字のみを取り出すのか、その方法をご紹介します。

お楽しみに。



だい

Googleの検索結果の総数一覧表を作成する その1(ExcelVBA）

今日もまた、生徒さんからの鋭い質問を取り上げます。

「先生、実は、こんなお願いがあるのですが。。。」

と言って、生徒さんは、以下のような表を見せてくれました。



「ほう、これは、何ですか？」

「検索の結果が何件あるのかを知りたいのです。いくつも、検索したいパターンがあるんです。
キーワードを入力しておきました。」

「なるほど、上田市　ラーメン　で、検索したときに、何件がヒットするのかを調べたいんだね。」

「そうです。今回は、Googleで検索しているのですが、いくつも検索したい項目があるのです。
表には、10パターンほど入力してありますが、実際は、もっとたくさん調べたいのです。
でも、何回も手作業で調べるのが、面倒くさくて。何とか、楽ができませんでしょうか。」

「素直な要望だね。よし、何とかしてあげよう！！」

「本当ですか？」

「はい、それでは、まず、普段どうやって調査しているのか、僕に見せてください。」


生徒さんは、僕に、作業の手順を見せてくれました。
まとめると、次のようになりました。

１．まず、Googleのサイトにアクセスして、検索窓に、キーワードを入力する。
（今回は、上田市　ラーメン　で、検索）




２．検索結果の総数が表示されるので、その数字を、メモする。




(拡大画像)




３．エクセルに、その数字を手入力する。今回は、359,000です。


「なるほど、その作業を、今回の表では、10回繰り返すわけですね。」

「そうなんですよ。10回でも、大変なんですよねえ。」

「分かりました。そんなあなたのために、ボタン一つで一気に出来るプログラムを作りましょう。」



さて、今回は、エクセルの表の検索キーワードで検索した結果の総数を取得して、
順次エクセルの表に入力していくプログラムをVBAで制作します。

つまり、F列3行目からF列12行目までのセルに、自動的に、順次、検索結果の総数を代入していきます。

なお、今回のプログラムは、インターネットに接続できる環境が必要です。
でないと、Googleのサイトが表示されませんよね。


それでは、ここからが本題ですよ。

今回のプログラムの処理内容を順番に書いてみましょう。

１．表の3行目にある検索キーワードを、Googleの検索窓に入力する
２．検索する
３．検索結果が表示されたら、総数をコピーする。
４．表のF列3行目に貼り付ける。
５．表の4行目以降について、上記１～４を繰り返す


さて、手順1と手順2は、VBAでどのように実現したらいいのでしょうか？

注目するのは、検索時のURL（アドレス）です。

検索する際に、もろもろの情報をアドレスの後に付加して送信しています。（URLの?以降の部分）
これを、クエリストリングと言います。
この情報の中に、実は、検索キーワードも含まれているのです。



すべて表示すると、以下のようになります。
そして、赤線の部分が、キーワードの情報なのです。




日本語は、アルファベットと数字と記号に置き換えられて（エンコードといいます）、
送信されます。

ということは、この赤線の部分を、うまくプログラムで処理すれば、
任意のキーワードの検索結果のWebページを表示できそうです。


さて、それでは、実際どうしたらいいのでしょうか？

実は、エクセルには、こんなときに最適な機能があるのです。

それは、「外部データの取り込み」の「新しいWebクエリ」という機能です。

次回は、この機能を使って、検索結果の総数を取得するためのプログラムをご紹介しましょう。



だい