If 製番入力.TextBox2.Text<>"" Then
  Keijo=製番入力.TextBox2.Text
End If

TextBox2に形状を入力するときに、すべての文字を入力するのは面倒である。
それを省略するのが、[ワイルドカード]である。ワイルドカードは[*]である。
形状を入力するときに、他と判別できる文字列だけを入力する。

TS2040+1500LC7
TS2526+2500L
TS2525+2000L
上記の3品目の中から抽出する場合に[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種類になる。
   2. 入力フォームの、テキストボックスが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行目と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にあると仮定して、[特定の製番の行]を抽出する場合に、
 [マクロ記録]で手動操作したら、マクロではどのようになるのかを見てみましょう。

1.まず、Sheet2を作成して項目行をB3にコピーしておきます。
  抽出データが下にコピーされます。
  
                       
                 
  
                                                  l
  





                                                         

                                        
















                                                          


           
                                   
                                                               
                                                                  
                                                              
                                                          
















                                                               
                                                                  
                                                                  
                                                                
















                                                           
                                                           
                                                           
                                                        
                                                           

      

                              
                               
                                
                                   
                                
                                         
                                                       
                                                     
しn
 
基本的なマクロの習得
文字列操作
 
実際に使っているシステムの内容で解説
EXCEL VBA 講座