こんにちはゲストさん。会員登録(無料)して質問・回答してみよう!

解決済みの質問

該当の日付以外を消去するプロシージャを教えて下さい!

Excel VBAについてお聞きしたいことがあります。

ユーザフォームにテキストボックスとチェックボックスを設定し、
テキストボックスには日付の入力、チェックボックスには記号を選択するように作成しました。
(チェックボックスの記号は時間で設定しており、
0:00~08:59 =A
09:00~13:00 =B
13:00~15:59 =C
16:00~19:59 =D
20:00~23:59 =E と決めています。)

表のA列には年月日と時間(昇順)、B列にはA~Eの記号が入っています。(A列参照の関数を入れています。)

例えば、テキストボックス1に11/25,テキストボックス2に12/1
チェックボックス1にE , チェックボックス2にAと入力した場合、

11/25のEまでのデータと12/1のA以降のデータを削除する方法を教えて下さい。

まずdo loopを使って11/25までのものを探すプロシージャを書いたのですが、A列に時間が入っているためかわかりませんが、どうも日付を取得できません。

念のため、私が書いたものを記載しますが、
これ以外でもいい方法があれば教えていただければ幸いです!
どうぞよろしくお願いいたします。

----------------------------------------
dim myDate as Date

sub 指定日以外削除()
myDate = textbox1.Value
i = 1
Do Until Cells(i, 1) = ""
If Cells(i, 1).Value = myDate Then
Cells(i, 1).EntireRow.Delete Shift:=xlToLeft
End If
i = i + 1
Loop
End Sub

投稿日時 - 2009-12-02 14:16:16

QNo.5492403

すぐに回答ほしいです

質問者が選んだベストアンサー

こんばんは。

>チェックボックス1にE , チェックボックス2にAと入力した場合、
チェックボックスは、オン・オフだと思いますから、これはどういうことか良く分かりません。

myDate = textbox1.Value このままですと、うまくありません。

'-------------------------------------------
Sub 指定日以外削除()
  Dim myDate1 As Variant
  Dim myDate2 As Variant
  Dim tmp As Variant
  Dim i As Long
  
  myDate1 = TextBox1.Value
  myDate2 = TextBox2.Value
  
  '日付が入っていないとき
  If myDate1 = "" Or myDate2 = "" Or _
    Not (IsDate(myDate1) And IsDate(myDate2)) Then
    MsgBox "日付が入っていません。", vbExclamation
    Exit Sub
  Else
    '日付に変換
    myDate1 = CDate(TextBox1.Value)
    myDate2 = CDate(TextBox2.Value)
  End If
  
  'もし、日付の大小を逆に入れ違えたとき
  If myDate1 < myDate2 Then
    tmp = myDate2: myDate2 = myDate1: myDate1 = tmp
  End If
  ''-------------------------------------------削除実行
  Application.ScreenUpdating = False
  For i = Cells(Rows.Count, 1).End(xlUp).Row To 1 Step -1
    If VarType(Cells(i, 1).Value) = vbDate Then
      If Fix(Cells(i, 1).Value2) >= myDate2 And Fix(Cells(i, 1).Value2) <= myDate1 Then
        Cells(i, 1).EntireRow.Delete
      End If
    End If
  Next
  Application.ScreenUpdating = True
End Sub

投稿日時 - 2009-12-02 20:11:20

お礼

チェックボックスとオプションボタンを設定しようと思ったのでした。。。

すごく詳しく書いてくださってありがとうございます!!
参考にさせていただきます☆

また何かあったらどうぞよろしくお願いいたします。

投稿日時 - 2009-12-05 22:04:52

ANo.2

このQ&Aは役に立ちましたか?

1人が「このQ&Aが役に立った」と投票しています

回答(3)

ANo.3

Now()のように日付と時間が両方入っているな場合は
DateSerial関数でDateSerial(Year,Month,day)で日付が求まるよ。
YearはYear関数があるからそれを使う。Month、Dayも同じ。
何も難しくない。時刻もTimeSerial関数がある。
A1セルに=Now()とする。
Sub test02()
x = Cells(1, "A")
d = DateSerial(Year(x), Month(x), Day(x))
MsgBox d
End Sub
dには2009/12/2の日付シリアル値(正整数)が入る。
日付書式で2009/12/2に見えている。
時刻も同じ。

投稿日時 - 2009-12-02 23:54:55

補足

あ~なるほどです。
VBAの関数はまだまだ全然です。。。
勉強したいと思います。

回答くださってありがとうございます!
参考にさせていただきます。

また何かあったらどうぞよろしくお願いいたします。

投稿日時 - 2009-12-05 22:05:33

ANo.1

とりあえず年月日と時間が入っているセルと年月日を比較しても=が成立しないので
年月日と時間が入っているセルを年月日だけにします。
>If Cells(i, 1).Value = myDate Then
If int(Cells(i, 1).Value) = myDate Then

>Cells(i, 1).EntireRow.Delete Shift:=xlToLeft
行を削除するのだから
Cells(i, 1).EntireRow.Delete Shift:=xlup
だと思います。(処理には関係ないけど)

投稿日時 - 2009-12-02 15:00:02

お礼

あ、凡ミスを。。。
ご指摘ありがとうございます!

ありがとうございます!!
参考にさせていただきます☆
また、何かあればゼヒよろしくお願いいたします。

投稿日時 - 2009-12-05 21:56:45

あなたにオススメの質問