If 製番入力.TextBox2.Text<>"" Then
Keijo=製番入力.TextBox2.Text
End If
TextBox2に形状を入力するときに、すべての文字を入力するのは面倒である。
それを省略するのが、[ワイルドカード]である。ワイルドカードは[*]である。
形状を入力するときに、他と判別できる文字列だけを入力する。
TS2040+1500LC7
TS2526+2500L
TS2525+2000L
上記の３品目の中から抽出する場合に[TS25]だけをテキストボックスに入力すると
Keijo=TS25となる。
この場合
ActiveSheet.Range("B3:I" & intRow).AutoFilter Field:=3, Criteria1;=
"*" & Keijo & "*"
とすれば良い
"*" & Keijo & "*" は Keijoの前も後も、何の文字であっても,
Keijo だけが一致するものを抽出せよ
と言う命令である。だからTS2526+2500LとTS2525+2000Lの行が抽出される。
今は、TextBox1とTextBox2の両方に入力されてはいけないので、メッセージで警告をする。
[MsgBox " 両方入力してはいけません。" ] と表示される。[OK]をクリックして次に進む。
メッセージボックスの詳細使用方法は別の課題で説明します。
[Exit Sub]はプログラムを終了します。
Initialize( )にTextBox2.Text=""を記入します。
" と "の間は開けてはいけない。後に詳しく説明しますが、間が空けばその間に空白の文字列
スペースがあるものとして認識されます。
If TextBox1.Text <> "" Then
Call 変数によるフィルター抽出
End If
If TextBox2.Text <> "" Then
Call 形状の抽出
End If
上記のプログラムは、TextBox1が空白でなかったら、Callの後のサブプログラムを
実行すると言うことで、<>ではなく=と書くと、空白ならCallを実行することになる。
このプログラムの場合は、条件を入力すれば空白でなくなるから、TextBox1とTextBox2の
どちらに入力したのかによって、実行するサブプログラムが変わる。
又、どちらにも入力されていないと、何もしないでプログラムを終了することになる。
● If Thenの説明
簡単に言うと、何かがこう言う状態なら Then の次のプログラムを実行する。
何かがこう言う状態でなかったらThen の次のプログラムを実行する。
何か And 何かがこう言う状態ならThen の次のプログラムを実行する。
何か Or 何かがこう言う状態ならThen の次のプログラムを実行する。
と言うように、比較して分岐する場合に使用します。
他の使用方法は別の課題で説明します。
これを下記の様に書き換えて変更する。
[製番入力]文字をコピーして、テキストボックスの上に貼り付け、[形状入力]に変更すれば
フォームは完成である。
次にVBAの中で[製番入力]フォームの[抽出]ボタンをクリックするとフォームマクロが
表示される。
ここに[TextBox1]と[TextBox2]を書く。これは開いたときにテキストボックスを空白にする。
[Initialize]書式を記憶しておけば、自分で記入すればよい。
[Private Sub TextBox2_Click( )が作成される。
そこで、右の▼をクリックすると[Initialaze]があるので、クリックする。
[Private Sub UserForm_Initialize( )]ができる。
[Private Sub TextBox2_Change( )]も[Private Sub UesrForm_Click( )も不必要なので
選択して削除する。実は[Initialize( )]だけが欲しかっただけである。
この状態で上の▼をクリックすると、[UserForm]が表示されるのでそれをクリックする。
新しくできたテキストボックスをダブルクリックするとフォームのコードが表示される。
[TextBox2]になっているのが分かる。
背景を下に伸ばして、[抽出]ボタンを下に移動して間をあける。
上のテキストボックスをコピーして下に貼り付ける。
形状名は文字が多いので、テキストボックスを右に伸ばす。
フォームの変更
37. 更に改造して、[形状・寸法]でも抽出できるようにする。
変更で考える必要がある事項
1. 抽出条件が製番と形状の２種類になる。
2. 入力フォームの、テキストボックスが２種類必要になる。
3. テキストボックスの、どちらに条件が入力されたのかの判別が必要になる。
4. 抽出ボタンは一つで実行する。
36. VBAで新規モジュールを作成してコードを記入する。
Sheet1シートの[Sheet2]ボタンに[Sheet2]マクロを登録し、Sheet2シートの[メニュー]ボタンに
[メニュー]マクロを登録する。これで、シート間の移動がボタンで出来るようになった。
Sheet2シートに[メニュー]のボタンを配置する。
Sheet1シートに[Sheet2]のボタンを配置する。
35. ここでSheet1とSheet2を移動するようになるので、移動ボタンが
必要になった。
●このようなボタンセットがあれば、いつでもそこからコピーして
使用できるので便利である。
だから、ボタンを作成した時はセットに集めて、保存するように
するとよい。
今回はこの[メニュー]と、コピーして文字を[Sheet2]に変更した
ものを使用します。
[抽出]ボタンをクリックすると、フォームが表示されて、[製番]を入力するとSheet2に結果が抽出された。
34. [抽出]ボタンをクリックすると、フォームが表示されて、[製番]を入力し、
フォームの[抽出]ボタンをクリックすると、、Private Sub BT_Click( )が実行される。
Unloadは、そのあとに書かれたフォームを非表示にします。
抽出結果が表示されたSheet2に移動する。A1セルに移動する。
上記のコードを追加します。
フォームに入力した製番を、フィルター条件で抽出するように変更する。
[製番入力]と言うフォームの、[TextBox1]に記入された[Text]を[Seib]と言う名の
変数に代入する。と言うように変更します。
Sheet1のD2に入力した製番をフィルター条件にしていた。
33. このプログラムを、フォーム入力に対応するように改造します。
VBAメニューバーの[プロジェクトエクスプローラー]をクリックすると[プロジェクト]が
開きます。
その中の、フォームを開くと[製番入力]が表示されている。ダブルクリックすると、VBAが
開かれる。なお、[エクスプローラー]と[プロパティ]は右上の[×]で閉じられます。
32. [ボタン]を右クリックして、[マクロの登録]で[製番抽出]を選択して[OK]をクリックする。
[ボタン]をクリックするとフォームが表示されます。フォームの右上の[×]で閉じます。
[製番入力.Show vbModeless]は
[製番入力]は実行するフォームの名前です。
[Show]はフォームを表示する書式です。
[vbModeless]はExcel上に表示されたフォームを、マウスで自由に位置の移動ができる。
これは省略が可能ですが、省略すると移動はできません。
[抽出]ボタンを配置します。
VBAの[挿入]-[標準モジュール]を順にクリックして、新規モジュールを作成し、
下記のコードを参考に入力します。
31. 入力フォームを表示するためのボタンを配置する。
30. テキストボックスをクリックすると、プロパティウインドウの(オブジェクト名)に
テキストボックスの名前が[TextBox1]と表示される。
これは、連続番号で作成されるので識別はしやすいが変更してもよい。
29. ボタンをダブルクリックすると、ボタンのコードが表示されます。
ボタンをクリックしたときに、ここに記入されているマクロが実行される。
ボタンをクリックすると、[プロパティウインドウ]の[Caption]に表示される。
ここで変更が可能です。文字サイズは[Font]で、文字色は[Fore Color]、ボタンの色は
[Back color]で変更できます。
ボタンが[CommandButton1]と表示されている。これはボタンの名前です。
これを[BT]に変更する。(使用できる文字は、英数と漢字、かな)
28. [ツールボックス]の[コマンドボタン]をクリックすると、ボタンを作成できます。
コマンドボタンをクリックして、フォーム上に配置する。
27. フォームの表示名が[UserForm2]になっている。
プロパティウインドウの[Caption]に書かれている。
ここを変更すれば、表示名が変更できる。
適当な大きさに設定します。
本来は、文字を実際に書かなくても良いので設定だけします。
ここに書いた文字が、フォームを開いたときに表示されてしまう。
[Fore Color]は文字の色を選択出来ます。
テキストボックスの中に記入する、文字の大きさを設定するために仮に書いてみます。[プロパティウインドウ]の[Font]-[▼]-[サイズ]で選択する。
[テキストボックス]を選択して、外周に[ドット]が付いた状態でカーソルを近づけると
カーソルが[十字]になるので、その時にドラッグすると移動できる。
26. [ツールボックス]の[テキストボックス]アイコンをクリックして、フォーム内の
任意の位置で、左上から右下まで選択すると、テキストボックスが配置される。
その[Caption]のLabel1の文字を直接変更すると、フォームの文字も変更される。
フォームの文字サイズが変わった。
文字がLabel1になっている。
プロパティウインドウの[Caption]がLabel1になっている。
フォントの[サイズ]を選択して[OK]をクリックする。
25. 文字の大きさを変えるのは、[Font]の右の[▼]をクリックする。
プロパティウインドウの[Fore Color]の色も変わり、フォームの文字の色も変わった。
[パレット]の中の色をクリックすると、文字の色が変わります。
24. 文字の色は、[Fore Color]の右の[▼]をクリックする。
23. プロパティウインドウが、出ていなかったら開いてください。
22. 左上から右下へドラッグして大きさを決める。
外周にドットが付いている間は、その位置で伸縮できます。
21. 次に、文字を配置する。
ツールボックスの[ラベル]をクリックし、フォームの背景にカーソルを置く。
20. [全体]-[▼]-[パレット]を順にクリックすると色見本が表示される。
色を選択すると、背景色が変わる。
19. フォームの背景はBask Colorで設定できる。
18. [プロパティウインドウ]をクリックすると、プロパティの明細が表示される。
フォームの内容はプロパティで設定できる。[
17. フォームの中に[User Form]が表示されている。
フォームが表示されていないときは、この中から開きたいフォーム名をクリックする。
開かれたユーザーフォームの名前は、[UserForm1]になっている。
16. VBAの[プロジェクト]をクリックするとプロジェクトの内容が開かれる。
VBAの[挿入]をクリックすると、新規の[User Form]が開かれる。
ツールボックスも同時に開かれる。（開かれないときは、[表示]-[ツールボックス]を順にクリックする。)
15. フォームの作成。
●フォームを使用して、抽出フィルター条件を可変にするための改造
Sub 変数によるフィルター抽出()
Dim intRow As Integer ' IntRow変数は(Integer)数値だと定義する。
Dim intR As Integer
Dim I As Integer
Dim i2 As Integer
Sheets("Sheet2").Select
Range("B4:I50").ClearContents ' データの消去
Sheets("Sheet1").Select
intRow = Range("B3").End(xlDown).Row ' Sheet1のB3から下へ、データ範囲の最下行を
' 調べてその行番号を、intRow変数に代入する。
Seib = Range("D2") ' セルD2の値をSeibに代入する。
Range("B3:I" & intRow).Select ' B3からI列のintRow行までを選択する。
Selection.AutoFilter ' 選択範囲をフィルターする。
ActiveSheet.Range("B3:I" & intRow).AutoFilter Field:=1,
Criteria1:=Seib
' Field1=B列の製番の中から、Seib変数をキーとしてフィルター抽出する。
I = 1
i2 = 4
For Each FilterRow In Worksheets("Sheet1").Range("B3").
_
CurrentRegion.Resize(, 1).SpecialCells(xlVisible) ' Sheet1のB3を基点としたデータ範囲を指す。
If FilterRow.Row >= 4 Then ' Sheet1のフィルター結果で4行目と４行目以上にデータがあれば
intR = FilterRow.Row ' その行番をintRに代入する。
Worksheets("Sheet1").Select
Range("B" & intR & ":I" & intR).Copy '
B列のintR行からI列のintR行までをコピーする。
Worksheets("Sheet2").Select
Range("B" & i2).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks
_
:=False, Transpose:=False
' Bのi2列に値だけ貼付ける。
i2 = i2 + 1 ' Sheet2のi2行にデータを貼り付けたので、次に同じ位置に貼りつかないように
' プラス1しておく。
I = I + 1 ' Sheet1のI行からデータを取得したので、次はプラス1した位置から取得する。
End If
Next FilterRow ' For_Nextについては後に説明します。
Sheets("Sheet1").Select
ActiveSheet.AutoFilterMode = False ' フィルターモードの解除
Application.CutCopyMode = False ' コピーモードの解除
End Sub
プログラムの説明
14. 抽出された5行をすべて、Sheet2に貼り付けた完成状態です。
改造したものが下記のプログラムです。
プログラムの説明
Sub フィルター抽出()
Range("B3:I16").Select ’ セルの指定は Range(" ") と書く
Selection.AutoFilter ’ フィルターの開始
ActiveSheet.Range("$B$3:$I$16").AutoFilter Field:=1, Criteria1:="NK-8272"
’ (注) Fild:=1 の1はデータ範囲の1列目を指す。
Range("B4:I6").Select
Selection.Copy
Sheets("Sheet2").Select
Range("B4").Select
’ 値だけ貼り付け
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks
_
:=False, Transpose:=False
Range("A1").Select
Sheets("Sheet1").Select
Range("A1").Select
Application.CutCopyMode = False ’ コピーモードを解除
Selection.AutoFilter ’ フィルターの解除
End Sub
13. Sheet1の抽出結果から、7行目をコピーして、Sheet2の5行目に貼り付ける。
● このマクロでは、[フィルターの選択範囲]も[抽出する製番]も[抽出された結果行]も
固定値が使用されている。
これを変数値にしないと、実際には使用できない。
次に、自動可変にする方法を解説します。
7．上記がVBAに記録されたマクロです。
11. 抽出結果は、5,7,9,11,13の行である
このように、抽出されたデータは連続の行ではない。
だから、何行目が抽出されたのか分からないと、Sheet2にコピーできない。
9. 新しい抽出データが入るので、Sheet2のデータを消去する。
3．各列にフィルターマークが付いた。
B列の▼マークをクリックすると、左記のダイアログが表示される。
(すべて選択)にチェックが入っているので、チェックを外して
NK-8272だけにチェックを付ける。
[OK]をクリックする。
● これを改造して、製番別に形状を抽出し、仕入先別に品名を抽出することができる。
データベースの中から抽出する方法の基本形である。
12. Sheet1の抽出結果から、5行目をコピーして、Sheet2の4行目に貼り付ける。
8. 変数を使用した条件の可変化
上記のプログラム構造を改造して、抽出条件をD2セルに入力する方法では、
どのようになればよいのか、イメージしてみましょう。
10. Sheet1のD2に抽出条件を、[NK-8271]と入力してマクロを実行すると、結果5列が抽出された。
6. Sheet2のB4に貼付けます。
A1を選択して、Sheet1に戻ってA1を選択して、[データ]の[フィルター]をクリックする。
[記録の終了]をクリックする。
4．NK-8272だけが抽出された。
5. B4からI列のデータ最下行までを、選択してコピーする。
2．[マクロ記録]をクリックして、マクロ名を[フィルター抽出]にします。
データ範囲を選択する。(B3:I16) [データ]-[フィルター]をクリックする。
●このようなデータベースがSheet1にあると仮定して、[特定の製番の行]を抽出する場合に、
[マクロ記録]で手動操作したら、マクロではどのようになるのかを見てみましょう。
１.まず、Sheet2を作成して項目行をB3にコピーしておきます。
抽出データが下にコピーされます。
基本的なマクロの習得
文字列操作
実際に使っているシステムの内容で解説
EXCEL VBA 講座
