エクセルでプロシージャが終了しません。

質問

ユーザーフォームのボタンをクリックしたら、特定のセルに現在の時刻を入力するマクロを作っています。
入力するところまではうまくいったのですが、プロシージャが終了しないので保存することができません。
どこが違うのかわからないので、わかる方よろしくお願いいたします。

Private Sub cmd1_Click()

Dim hiduke As Date
Dim hiduke2 As Integer

hiduke = Now()
hiduke2 = CInt(Day(hiduke))

If chk1.Value = True Then
Cells(4, 1).Select
Do Until ActiveCell.Value = hiduke2

ActiveCell.Offset(1, 0).Select

Loop

ActiveCell.Offset(0, 2).Value = hiduke

Else
Cells(4, 1).Select
Do Until ActiveCell.Value = hiduke2

ActiveCell.Offset(1, 0).Select

Loop

ActiveCell.Offset(0, 8).Value = hiduke

End If
End Sub

回答No.4

Wendy02 · ベストアンサー

こんばんは。

＞Do Until ActiveCell.Value = hiduke2

hiduke2 はIntegerですから、ActiveCell.Value といっしょになるだけではなく、もう1つ、IsEmpty(ActiveCell.Value) が、True になる部分を、エラー処理としてループの中などに置くのが自然です。ただ、見つからない場合は、おそらく、1列目に書かれている日付がおかしいと思います。たぶん、シリアル値ではありませんか？
Text プロパティで比較という方法もあるのですが、私は、あまり、そういう比較方法は、信頼性が低いと思います。

Excel VBAは、裏技的ですが、こういう処理の仕方があります。

例えば、日付の数字だけなら、

Dim Ret As Variant　
If chk1.Value = True Then
　　Ret = Application.Match(hiduke2, Columns(1), 0)
　　If Not IsError(Ret) Then
　　　　Cells(Ret, 2).Value = hiduke
　　End If
Else
・
・
・

じぁ、シリアル値の時はどうするか？

Dim RngAdd As String
　RngAdd = Range("A1", Range("A65536").End(xlUp)).Address
If chk1.Value = True Then
　　Ret = Evaluate("Match(" & hiduke2 & ",Day(" & RngAdd & "), 0)")
　　If Not IsError(Ret) Then
　　　　Cells(Ret, 2).Value = hiduke
　　'Else
　　'　 MsgBox "見つかりません。"
　　End If
Else
・
・
・

配列数式で処理します。なお、これは、私のオリジナル・テクニックではありません。

お礼

早速の回答ありがとうございます。
1列目の値は手入力した数値になっています。
もしかしたらそれがいけないのでしょうか・・・。
教えてもらったシリアル値での処理も試してみたいと思います。
ありがとうございますm(__)m

回答No.10

masa_019

>早速ためしてみたところ、『$A$12:9』と表示されました。

#9のKenKen_SPさんの回答に1票！。

お礼

こんばんは☆
やはり#9さんの回答が大きなヒントなのですね！
私のやり方がマズイのか、■が邪魔してうまくいかないのですが、また１からじっくりやってみます。
ありがとうございます。

補足

この場をお借りして皆様にお礼申し上げますm(__)m
初心者な私に親切にアドバイスしていただけて、大変勉強＆参考になりました。
基礎を知らずになんとなくVBAを使っていたので、１からしっかり勉強してみようと思います。
皆様にポイントを差し上げたいのですが、なんとお二人様にしかポイントをつけることができないようです。
どれも選べないぐらい感謝していますが、ランダムでお二人様だけにポイントを付けさせていただきます。
（でも本当は皆様に1000ポイントぐらい差し上げたい気持ちです）
また相談することもあるかと思いますが、その時はよろしくお願いいたします。
本当にありがとうございました。

回答No.9

KenKen_SP

#8 の続きですが、、

＞ここで止まってしまって、End Subまで実行してくれません。

End Sub の直前に

Unload Me

の一行を入れて、実行してみて下さい。セルへの転記
の後でフォームが自動で閉じるはずです。

この状態をEnd Sub まで実行した、、と勘違いされて
いるとか？

お礼

ありがとうございます☆
フォームは自動で閉じました！
が、、、やっぱり・・・（笑）
本当に親切に教えていただいて、ありがとうございますm(__)m

回答No.8

KenKen_SP

> VBEの画面のリセットボタン（■←こういうマークのボタン）を
> 押さないと、

フォームは表示されているのですよね？

フォームの[X]ボタン（閉じる）をクリックしないと、VBE とか
EXCEL の保存等の操作はできないと思いますが、、

この意味ではないですよね？

お礼

こんばんは。
フォームは×で閉じてみたりもしたのですが、やはり■のリセットボタンを押さないとウンともスンとも言いませんでした(x_x;)
一度、表から作り直してみますね(^^;)

回答No.7

Wendy02

red-satoさん、こんばんは。

＞1列目の値は手入力した数値になっています。
＞もしかしたらそれがいけないのでしょうか・・・。

私の目算は、どうやら外れたみたいだけれども、手入力だから、どうこということはありませんね。ワークシート上の日付などの値を、VBAで検索をする場合は、そのまま扱うと失敗する率が高いのですね。私は、今は、関数による配列数式やシリアル値の検索が一番うまくいきます。絶対ということではありません。後は、ローカルウィンドウで、それぞれの変数の値を確認することでしょうね。その上で、できれば、型は同じにさせたほうが確実です。

お礼

こんばんは。
アドバイスありがとうございます。
基礎的なことをわかっていないのを痛感いたしました(^^;)
勉強も兼ねてイロイロ試してみたいと思います！

回答No.6

masa_019

コードの最後、End Subの直前に
Debug.Print ActiveCell.Address & ":" & ActiveCell.Value
と付け加えて実行したら、イミディエイトウインドに
何と表示されますか？

お礼

こんばんは。
何度もお手数お掛けしてすみません。
早速ためしてみたところ、『$A$12:9』と表示されました。

回答No.5

masa_019

>終了条件に一致する値は存在していて、ループが終了しています。
>そして『ActiveCell.Offset(0, 2).Value = hiduke』が実行されて特定のセルに現在の時刻が入力されます。
>しかし、ここで止まってしまって、End Subまで実行してくれません。

プロシージャが終了しないとのことなので、ループが
終わらないのかと思っていましたが、違うようですね。
では、エラーでストップしているということですか？
ループが終了して、
ActiveCell.Offset(0, 2).Value = hiduke
が実行されるのならとりあえず最後まで
走っているのではないでしょうか。
それなのにEnd Subまで走らないということは
提示されたコードは全体の一部分なのでしょうか？
止まったときにVBE画面のコードで黄色く強調される
部分があると思いますので、それを教えてください。
また、そのときに出るエラーメッセージもお願いします。

お礼

ありがとうございます。
説明不足ですみません(x_x;)
質問で書いたコードは全てコピペしたもので、変更した部分などはない状態です。
また、黄色の反転やエラーメッセージがないのです。
VBEの画面のリセットボタン（■←こういうマークのボタン）を押さないと、他の操作が何もできない状態で、保存もできません。
何か私が初歩的な勘違いをしているような気がしてきました・・・(^^;)

回答No.3

KenKen_SP

検索部で該当セルが見つからないとどんどん下にカーソルが移動して
いきますが、それは置いておくとして、

> そして『ActiveCell.Offset(0, 2).Value = hiduke』が実行されて
> 特定のセルに現在の時刻が入力されます。

それでは、このコードにエラーとなる要素がありません。コードの
掲載に省略された部分がありますか？

お礼

早速の回答ありがとうございます。
該当セルは存在するはずで、該当セルの所でループは止まっている状態です。（見落としがあるのかもしれませんが・・・）
コードは全文コピペしたもので、省略している部分はありません。
やっぱり私が何か勘違いしているのでしょうか(^^;)

回答No.2

KenKen_SP

こんにちは。KenKen_SP です。

エラーメッセージの内容は教えて下さいね。

保護されているため、セルに書き込めないというのは？

お礼

早速の回答ありがとうございます。
エラーメッセージは表示されません。
また黄色く反転する部分もないのですが、VBEの画面のリセットボタン（■←こういうマークのボタン）を押さないと、他の操作が何もできない状態です。
最初は保護していたのですが書き込めなかったので解除済みです(^^;)
説明下手ですみません。よろしくお願いします。

回答No.1

masa_019

Cells(4, 1).Select
からループが始まっていますから、
A4セル以下にループの終了条件に一致する値
(hiduke2)が無いのではないですか？

でもほおって置いても最終行までループすれば
エラーでストップしますね。

お礼

回答ありがとうございます。
終了条件に一致する値は存在していて、ループが終了しています。そして『ActiveCell.Offset(0, 2).Value = hiduke』が実行されて特定のセルに現在の時刻が入力されます。
しかし、ここで止まってしまって、End Subまで実行してくれません。

特に何もない部分なのになぜでしょう・・・(^-^;?