VBA; ユーザーフォームからの処理

質問

Excel 2007を使用しています。
下記のようなことを考えています。

1. テキストボックスにYYYY/M形式の日付データを入力
2. コマンドボタンを押下。
3. 日付データを確認
4. オリジナル(sheet1)の列値、日付データ(A列)、商品番号(B列)、商品名(C列)から条件に
該当した行をサマリー(sheet2)にコピー。
オリジナルの3行目のベッダー情報は先頭に置いて、その下に該当行を付ける。

オリジナルデータ;
注文日付 商品番号 商品名
2010/9 312000 ノコギリ
2011/12　　 542000 ハンマー
. . .
. . .
2014/5 312000 ノコギリ

サマリー;
注文日付 商品番号 商品名
2010/9 312000 ノコギリ
2014/5 312000 ノコギリ

ご質問;

1. 上記3、4の処理はコマンドボタンのクリックイベント処理として、まとめて
記述すれば 良いのでしょうか?

2. 日付データのオブジェクト名を"TextBox1"として、コマンドボタンのクリックイベント処理
など、これらの処理を行うにあたりサンプルなるコードはありませんか?
　 オリジナルの行数は変動します。

3. ユーザーフォームを作らずにシート上(shhet1)にテキストボックス、
コマンドボタンを作成できますか?
　 ありましたら方法を教えてください。

以上、宜しくおねがいします。

回答No.1

eden3616 · ベストアンサー

1. 上記3、4の処理はコマンドボタンのクリックイベント処理として、まとめて
記述すれば 良いのでしょうか?

まとめて一つのプロシージャで処理出来ます。

2. 日付データのオブジェクト名を"TextBox1"として、コマンドボタンのクリックイベント処理
など、これらの処理を行うにあたりサンプルなるコードはありませんか?
　 オリジナルの行数は変動します。

「最終行セルのオブジェクト.End(xlup).Row」で最終行の行番号を取得できます。
以下参照。

3. ユーザーフォームを作らずにシート上(shhet1)にテキストボックス、
コマンドボタンを作成できますか?

できます。以下参照。

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

(1)前提条件：
・シート名は「オリジナルデータ」と「サマリー」（出力先）とします。
・オリジナルデータは3行目に項目行が1行あり、4行目からデータが入力されているとします。
・サマリーシートは1行目に項目行（1行）、2行目からコピーしたセルを貼り付けます。

(2)オリジナルデータシートにコントロールを配置する方法：
・エクセルの開発タブ（無ければエクセルオプションから表示設定してくさい）の
　挿入からActiveXから「テキストボックス」と「コマンドボタン」を配置してください。
・各コントロールを(開発タブのデザインモードをONにして)右クリック＞プロパティを表示し、
　オブジェクト名を「Textbox1」と「CommandButton1」としてください。
・コマンドボタンの表示名は同じくコマンドボタンのCaptionプロパティで変更できます。

(3)コードの追加
・(開発タブのデザインモードがONの状態で)コマンドボタンをダブルクリックしてVBE画面を開く。
・「Private Sub CommandButton1_Click() ～ End Sub」を最下のVBAコードと差し換え。

(4)VBAの実行
・開発タブのデザインモードをOFFにした状態にする。
・テキストボックスに「yyyy/m」形式で日付を入力。
・コマンドボタンをクリックします。
・結果がダイアログで表示されます。

シートが無い等のエラー処理は行っていませんので必要であれば追加してください。
様式に変更がある場合は適切に修正願います。

■VBAコード

Private Sub CommandButton1_Click()
'変数を定義
Dim i As Long
Dim maxRow As Long
Dim cnt As Long
Dim outSheet As Worksheet

'出力先のシートをオブジェクト変数へ格納
Set outSheet = Worksheets("サマリー")

'テキストボックスの内容を判定
If (Me.TextBox1.Value = "") Or (Not IsDate(Me.TextBox1.Value)) Then
　　MsgBox "日付が入力されていません"
　　Exit Sub
End If

'最終行番号を取得
maxRow = Me.Cells(Rows.Count, "A").End(xlUp).Row

'オリジナルデータの最終行番号で分岐処理
If maxRow > 3 Then
　　'出力先を削除してヘッダーをコピー
　　outSheet.Cells.Delete
　　Me.Range("A3:C3").Copy outSheet.Range("A1:C1")
Else
　　'4行目以降にデータが入力されていなければメッセージで終了
　　MsgBox "オリジナルデータがありません"
　　Exit Sub
End If

'4行目から最終行まで繰り返し
For i = 4 To maxRow
　　'A列が日付であれば処理
　　If IsDate(Me.Cells(i, "A").Value) Then
　　　　'テキストボックスの年/月とA列が一致した行をコピー
　　　　If Year(Me.Cells(i, "A").Value) = Year(Me.TextBox1.Value) And _
　　　　Month(Me.Cells(i, "A").Value) = Month(Me.TextBox1.Value) Then
　　　　　　Me.Cells(i, "A").Resize(1, 3).Copy outSheet.Cells(cnt + 2, "A")
　　　　　　cnt = cnt + 1
　　　　End If
　　End If
Next i

'結果表示
If cnt > 0 Then
　　MsgBox cnt & "件コピーしました"
Else
　　MsgBox "一致する日付が有りませんでした"
End If
End Sub