Excel 2007 VBAを使用しています。 下記のようなことを考えています。 1. テキストボックスにyyyy/m形式の日付データを入力 2. ボタンシートのコマンドボタンを押下。 3. テキストボックスの日付データを確認 4. 商品シートの列値、日付データ(A列)、商品番号(B列)、商品名(C列)、状況(D列)から条件に 該当した行を結果シートに行コピー。 ただし、日付データ(A列)には日付データ以外にも文字列データ、"未定"、空白セル("")などがございます。 そして、商品シートの3行目のベッダー情報は先頭に置いて、その下に該当行を行コピーしていく。 質問; 解らないのは、同じif文で日付データと文字列データとの処理です。 テキストボックスのyyyy/m形式の日付データを基にその日付以降の該当する行を別のシートに コピーしていくのですが、参照元の商品シートの日付データ(A列)には他に文字列データが存在します。 この文字列データも抽出の対象にしたいのです。 あと、テキストボックスのyyyy/m形式の日付データは半角入力しますが全角入力されたとき エラー表示させる方法はありますか? これらの処理を行うにあたりサンプルなるコードはありませんか? 商品シートの3行目のベッダー情報は先頭に置いて、その下に該当した行を行コピーしていく。 1. 商品シート; 注文日付商品番号商品名状況 2010/9312000 ノコギリ受取済み 2014/5 542000ハンマーn/a 未定 544000トンカチn/a (空白セル)542000ハンマーn/a 2014/11312000 ノコギリ注文中 ・ ・ 2. ボタンシートで、日付データを入力(2014/5)、実行ボタンを押下。 条件は2014/5以降で、状況が"受取済み"、"注文中"以外の行データをコピーして状況が未確定のリストを作成します。 そして、注文日付が"未定"、空白セル("")の行データもコピーします。 そして、順次、結果シートに行コピーしてします。 結果シート; 注文日付商品番号商品名状況 2014/5 542000ハンマーn/a 未定 544000トンカチn/a (空白セル)542000ハンマーn/a ・ ・ VBAコード; Option Explicit Private Sub CB2_Click() '変数を定義 Dim i As Long Dim maxRow As Long Dim cnt As Long Dim inSheet As Worksheet Dim outSheet As Worksheet '入出力先のシートをオブジェクト変数へ格納 Set inSheet = Worksheets("商品シート") Set outSheet = Worksheets("結果シート") 'テキストボックスの内容を判定 '全角入力されたときエラー表示させる方法はありますか? If (Me.TextBox1.Value = "") Or (Not IsDate(Me.TextBox1.Value)) Then MsgBox "日付が正しく入力されていません" Exit Sub End If maxRow = inSheet.Cells(Rows.Count, "A").End(xlUp).Row '商品シートの最終行番号で分岐処理 If maxRow > 3 Then '出力先を削除してヘッダーをコピー outSheet.Cells.Delete inSheet.Range("A3").EntireRow.Copy outSheet.Range("A1") Application.CutCopyMode = False Else '4行目以降にデータが入力されていなければメッセージで終了 MsgBox "該当データがありません" Exit Sub End If '4行目から最終行まで繰り返し For i = 4 To maxRow 'ここからが上手くいきません。 'If IsDate(inSheet.Cells(i, "A").Value) Then 'フィルター条件; 'A列 注文日付 → 2014年05月以降、未定、(空白セル) 'D列 金額 → 受取済み、注文中以外 If inSheet.Cells(i, "A").Value >= CDate(Me.TextBox1.Value) And _ CStr(inSheet.Cells(i, "A").Value) = "未定" And _ CStr(inSheet.Cells(i, "A").Value) = "" And _ CStr(inSheet.Cells(i, "D").Value) <> "受取済み" And _ CStr(inSheet.Cells(i, "D").Value) <> "注文中" Then inSheet.Rows(i).Copy outSheet.Rows(cnt + 2) cnt = cnt + 1 End If 'End If Next i End Sub
↧