エクセルVBAのFunction簡素化したいのです・・・。

質問

時間により挨拶の内容を変えるCODEを作りました。一応、当初の目的どおりのは答えを返すのですが、時間と分で２つFunctionが出来てしまいます・・・・。
あと、もっとスマートなやり方はないものかと質問させていただきました。
くだらないと思われそうですがなにとぞよろしくお願いします。

Sub 挨拶test()
MsgBox hmsg(Time) & Chr(10) & messe(Time), , "*・゜゜・*:.。. .。.:*・゜゜・*"
End Sub

Function messe(t) As String
t2 = Hour(t)
t3 = Hour(TimeValue(t) + TimeValue("01:00"))
m = Minute(t)
Select Case m
Case Is < 15: messe = t2 & "時を回りましたね。 。(^o^)/"
Case Is < 30: messe = "もうすぐ" & t2 & "時半になりますね。 (〃^∇^〃) "
Case Is < 45: messe = t2 & "時半を過ぎてますね。 (=´▽｀）ゞ"
Case Else: messe = "もうすぐ" & t3 & "時になるんですね。（＾∇＾）"
End Select
End Function

Function hmsg(t) As String
Select Case Hour(t)
Case Is <= 11: hmsg = "おはようございます。"
Case Is < 17: hmsg = "こんにちは。"
Case Else: hmsg = "こんばんは。"
End Select
hmsg = UCase(Environ("UserName")) & "さん、" & hmsg
End Function

回答No.7

pauNed · ベストアンサー

こんにちは。
簡素化という観点から外れて、ちょっと遊んでしまいましたm(_ _)m

Sub try()
　　Dim q, w, e, r
　　Dim t　 As Single
　　Dim h　 As Long
　　Dim m　 As Long
　　Dim x　 As Long
　　Dim i　 As Long

　　q = VBA.Array("", "おはようございます。", "こんにちは。", "こんばんは。")
　　w = VBA.Array("もう0時ですよ。 早く寝ましょうよ。", _
　　　　　　　　　"0時を回りましたね。", "もうすぐ0時半になりますね。", _
　　　　　　　　　"0時半を過ぎてますね。", "もうすぐ0時になるんですね。")
　　e = VBA.Array("(T_T)", " 。(^o^)/", " (〃^∇^〃)", " (=´▽｀）ゞ", "（＾∇＾）")
　　r = Array(0, 5, 12, 17)

　　t = Timer
　　h = t \ 3600
　　x = CLng(Application.Match(h, r)) - 1
　　If x > 0 Then
　　　　m = (t \ 900) Mod 4 + 1
　　　　i = Int(Rnd * 4) + 1
　　End If
　　If m = 4 Then h = h + 1
　　MsgBox UCase(Environ("UserName")) & "さん、" _
　　　　　 & q(x) & vbLf & Format(h, w(m)) & e(i), _
　　　　　 Title:="*・゜゜・*:.。. .。.:*・゜゜・*"
End Sub

解り易いとも思えませんのであまりおすすめしません。
Timer使う必然性もないですし...
#あ、でも Rnd はちょとおもしろいかも^ ^

お礼

Timer関数、VBA.Array関数、演算子「\」
初めて勉強させていただきました。
有難うございます。

回答No.13

pauNed

（#12コメントへのレスです）
『無駄』ではないと思いますよ。普通はそれで良いと思います。
私もプロではないので断言するわけではないのですが、
Functionって関数なので、そのFunctionの戻り値をどういうふうに返したいのか、
という意志入れ次第ではないでしょうか。

あえて蛇足するとして、挨拶MsgBoxのPromptとTitleを返す関数ととらえたら、
Functionの中で
hello = Array(q(x), Format(h, w(m)) & e(i))
とまとめて
MsgBox UCase(Environ("UserName")) & "さん、" & MyArr(0), vbInformation, MyArr(1)
とされてはどうでしょう。

また、下記のように変数の参照渡しを使う方法もありますが、
今回のケースではかえって解りにくくなると思います。参考まで。

Sub test02()
　　Dim Msg(0 To 1)　As String

　　If hello2(Timer, Msg()) = 0 Then _
　　　　MsgBox UCase(Environ("UserName")) & "さん、" & Msg(0), vbInformation, Msg(1)
End Sub

Function hello2(ByVal t As Single, ByRef Arg() As String) As Long
　　Dim Ar1, Ar2, Ar3, matchX
　　Dim h As Long
　　Dim m As Long
　　Dim x As Long
　　Dim i As Long

　　On Error Resume Next
　　Ar1 = Array("", "おはようございます。", "こんにちは。", "こんばんは。")
　　Ar2 = Array("もう0時ですよ。 早く寝ましょうよ。", _
　　　　　　　　"0時を回りましたね。", "もうすぐ0時半になりますね。", _
　　　　　　　　"0時半を過ぎてますね。", "もうすぐ0時になるんですね。")
　　Ar3 = Array("(T_T)", " o(^-^)o", " (〃^∇^〃)", " (=´▽｀）ゞ", "（＾∇＾）")
　　matchX = Array(0, 4, 12, 17)
　　h = Int(t / 3600)
　　x = CLng(Application.Match(h, matchX)) - 1
　　If x > 0 Then
　　　　m = Int(t / 900) Mod 4 + 1
　　　　If m = 4 Then h = h + 1
　　　　i = Int(Rnd * 4) + 1
　　End If
　　Arg(0) = Ar1(x)
　　Arg(1) = Format(h, Ar2(m)) & Ar3(i)
　　hello2 = Err.Number '(例として)
End Function

お礼

> 『無駄』ではないと思いますよ。普通はそれで良いと思います。

ありがとうございました。
安心しました。

回答No.12

pauNed

こんにちは。
#8コメントへのレスです。
Rnd方式を使ってみられたのですね。お役に立てそうで何よりです。

変ではないのですが、
Array関数とVBA.Array関数では、Option Baseによって、挙動が変わってくるので
その点は留意しておかれたほうがよろしいかと思います。
http://www5b.biglobe.ne.jp/~yone-ken/VB/VBans1.html

あ、それから変数名
>Dim q, w, e, r
ってキーボードの端からテキトーに使っただけなので、もし本番で使われるなら、
ご自分のわかり易い変数名にされたほうが良いですよ^ ^;
（不親切なコードでごめんなさい）

また、蛇足ですが、#7のコードは一見メンテナンス性が良さそうですけど、
よく考えてみると、無駄な配列をつくってしまっているような気もします。
コードの簡素化と実行効率って、背反する場合もあるのではないでしょうか。
そういった点からは、#2のmshr1962さんのコードはシンプルで良いと思っていました。
そちらをFunction化されたほうが実用的かもしれませんね。
（いや、質問者さんのご判断で構わないとは思いますが^ ^;）

お礼

> Array関数とVBA.Array関数では、Option Baseによって、挙動が変わってくるので
> その点は留意しておかれたほうがよろしいかと思います。

ご配慮有難うございます。

甘えついでにもう一つご教示願えませんか？
先ほどのNo8で見ていただいた、わたしのFunction hello(t As Single) As Variantですが、Fuctionで計算した値を、
hello = Array(q(x), Format(h, w(m)), e(i))
というように一旦配列に入れ、Sub test01()側で、
MyArr = hello(Timer)
というように配列MyArrに代入し、さらに配列MyArrの何番目という感じでしか、q(x), Format(h, w(m)), e(i)のそれぞれの値を個別に取り出す方法を思いつかなかったのですが、なにか随分無駄をしているような気がします。
普通、Fuctionで計算したq(x), Format(h, w(m)), e(i)の値を、Sub test01()側で個別に取得するにはどうするものなのでしょうか？

回答No.11

noname#140971

ついでに・・・

作法１、手続きコードは書かない。
作法２、マジックナンバーは埋め込まない。

１についてのみ回答しました。そこで、２に関して補足。

様々な文字列データがプログラムコード中に書かれています。
これじゃ、コードの修正が大変です。
長いコードですと、ほとんど意味不明になる可能性が高いです。

　　T(0) = Hour(Jikan)
　　T(1) = Hour(TimeValue(Jikan) + TimeValue("01:00"))
　　T(2) = Minute(Jikan)

ここまでのコードに関しての是非は関知しません。
次は、作法２も考慮した書き方です。

これで、随分と、解析抜きにスッと全体の意味が理解できるようになったと思います。

Option Explicit

Const conECHO1 = "<%1>時を回りましたね。 。(^o^)/|| " & _
　　　　　　　　 "もうすぐ<%1>時半になりますね。 (〃^∇^〃)||" & _
　　　　　　　　 "<%1>時半を過ぎてますね。 (=´▽｀）ゞ||" & _
　　　　　　　　 "もうすぐ<%2>時になるんですね。（＾∇＾）"
Const conECHO2 = "おはようございます/こんにちは/こんばんは。"

Function messe(Jikan) As String
　　Dim T(2) As Integer
　　Dim Msg　As String

　　T(0) = Hour(Jikan)
　　T(1) = Hour(TimeValue(Jikan) + TimeValue("01:00"))
　　T(2) = Minute(Jikan)
　　Msg = Replace(conECHO1, "<%1>", Str(T(1)), , , vbTextCompare)
　　Msg = Replace(conECHO1, "<%2>", Str(T(2)), , , vbTextCompare)
　　messe = CutStr(Msg, _
　　　　　 "||", _
　　　　　 Abs((T(2) < 15) + (T(2) > 14 And T(2) < 30) * 2 + (T(2) > 29 And T(2) < 45) * 3 + (T(2) > 44) * 4))
End Function

Function hmsg(Jikan) As String
　　Dim T As Integer

　　T = Hour(Jikan)
　　hmsg = UCase(Environ("UserName")) & "さん、" & _
　　　　　 CutStr(conECHO2, _
　　　　　 "/", _
　　　　　 Abs((T <= 11) + (T > 11 And T < 17) * 2 + (T > 17) * 3))
End Function

Private Sub CommandButton1_Click()
　　MsgBox hmsg(Time) & Chr(10) & messe(Time), , "*・゜゜・*:.。. .。.:"
End Sub

お礼

ご丁寧になんども有難うございました。
半分くらいしか理解できませんがとても勉強になりました。

回答No.10

noname#140971

[[イミディエイト]
? CutStr("おはようございます/こんにちは/こんばんは。", "/", 1)
おはようございます

? CutStr("おはようございます/こんにちは/こんばんは。", "/", 2)
こんにちは

?　CutStr("おはようございます/こんにちは/こんばんは。", "/", 3)
こんばんは。

まあ、やろうとされていることは、幾つかの文章の何番目を使用するかということ。
ならば、上記のように CutStr関数一つで目的は達成できます。

１、"/"や"||"などで連結した文字列を作る。
２、何番目を抜き出すのかを指定する。

まあ、これだけで抜き出す手続きの一切は CutStr関数に任せるということです。
Select Case などを駆使して抜き出す手続きを考える必要はありません。

洗練されたコードとは、手続きが洗練されたコードではなく手続きそのものを書かなくて良いコード。
まあ、私は、このように考えます。

なお、CutStr関数は、標準モジュールに作らねばなりません。

バグは、引数自体に潜んでいました。
なにせ、従業員を送り迎えしなきゃならんので書きなぐって投稿。

バグ１、区切り文字として "||"は指定してない。
バグ２、何番目かを負の数で指定している。

一応、バグ取り後のコードです。

Function messe(Jikan) As String
　　Dim T(2) As Integer

　　T(0) = Hour(Jikan)
　　T(1) = Hour(TimeValue(Jikan) + TimeValue("01:00"))
　　T(2) = Minute(Jikan)
　　messe = CutStr(T(1) & "時を回りましたね。 。(^o^)/|| " & _
　　　　　 "もうすぐ" & T(1) & "時半になりますね。 (〃^∇^〃)||" & _
　　　　　 T(1) & "時半を過ぎてますね。 (=´▽｀）ゞ||" & _
　　　　　 "もうすぐ" & T(2) & "時になるんですね。（＾∇＾）", _
　　　　　 "||", _
　　　　　 Abs((T(2) < 15) + (T(2) > 14 And T(2) < 30) * 2 + (T(2) > 29 And T(2) < 45) * 3 + (T(2) > 44) * 4))
End Function

Function hmsg(Jikan) As String
　　Dim T As Integer

　　T = Hour(Jikan)
　　hmsg = UCase(Environ("UserName")) & "さん、" & _
　　　　　 CutStr("おはようございます/こんにちは/こんばんは。", _
　　　　　 "/", _
　　　　　 Abs((T <= 11) + (T > 11 And T < 17) * 2 + (T > 17) * 3))
End Function

Private Sub CommandButton1_Click()
　　MsgBox hmsg(Time) & Chr(10) & messe(Time), , "*・゜゜・*:.。. .。.:"
End Sub

＜標準モジュール＞

Public Function CutStr(ByVal Text As String, _
　　　　　　　　　　　 ByVal Separator As String, _
　　　　　　　　　　　 ByVal N As Integer) As String
　　Dim strDatas() As String

　　strDatas = Split("" & Separator & Text, Separator, , 0)
　　CutStr = strDatas(N * Abs((N <= UBound(strDatas()))))
End Function

補足

CutStrというのはユーザー定義関数なんですね？

回答No.9

noname#79209

余計なお世話とは思いますが...
職場のみんなが使うエクセルに組み込むと、
イヤイヤながら残業している人の中には
「うるせェ！好きでこんな時間まで仕事してるんじゃない！」
と感じる人もいるかも知れないので、ご注意を．．．

お礼

な～るほどぉ！
そういう配慮も必要ですね、有難うございました。

回答No.8

pauNed

#7
>If x > 0 Then
>　　m = (t \ 900) Mod 4 + 1
>　　i = Int(Rnd * 4) + 1
>End If
>If m = 4 Then h = h + 1

If x > 0 Then
　　m = (t \ 900) Mod 4 + 1
　　If m = 4 Then h = h + 1
　　i = Int(Rnd * 4) + 1
End If
...でしたm(_ _)m

お礼

有難うございました。
何箇所かのメッセージで使うので、以下のようなFunctionにしました。
変じゃないですよね？

Sub test01()
Dim MyArr As Variant
MyArr = hello(Timer)
MsgBox UCase(Environ("UserName")) & "さん、" & MyArr(0), vbInformation, MyArr(1) & MyArr(2)
End Sub

Function hello(t As Single) As Variant
Dim q, w, e, r
Dim h As Long, m As Long, x As Long, i As Long
q = Array("", "おはようございます。", "こんにちは。", "こんばんは。")
w = Array("もう0時ですよ。 早く寝ましょうよ。", _
"0時を回りましたね。", "もうすぐ0時半になりますね。", _
"0時半を過ぎてますね。", "もうすぐ0時になるんですね。")
e = Array("(T_T)", " o(^-^)o", " (〃^∇^〃)", " (=´▽｀）ゞ", "（＾∇＾）")
r = Array(0, 4, 12, 17)
h = Int(t / 3600)
x = CLng(Application.Match(h, r)) - 1
If x > 0 Then
m = Int(t / 900) Mod 4 + 1
If m = 4 Then h = h + 1
i = Int(Rnd * 4) + 1
End If
hello = Array(q(x), Format(h, w(m)), e(i))
End Function

回答No.6

Wendy02

こんばんは。

#1 さんと内容が意見が重複するのですが、私は、ちょっと自分なりに書いてみようと思って途中でやめました。merlionXX さんも、もう、ここでは常連でベテランの中に入るわけで、それを今更、私などが、特別の間違いもないものに、自分のスタイルを押し付けるのは間違いだと思ったのです。

「スマートさ」というのは、何かに対して洗練されている、ということであって、抽象的なものです。確かに、上級でない人のコードをみると直したいと思うこともあります。ただ、それは、「スマートさ」ではなくて、潜在的なエラーを読み取っただけであって、エラーの読みは、その人のスキルのひとつです。

もし、あえて基本的な問題でいうのでしたら、

変数は、それぞれの型で宣言してください。

Variant 型で設定する場合は、明示的な意図がないといけません。Option Explicit としてみて、エラーが返るのは、ベテランの方としては、かなりうまくありません。

Function hmsg(t As Date) As String
t が、Date 型ではなく、Variant 型なら、t の型の判定を、IsDate にして受けなくてはなりません。

それと、ある程度、VBAに慣れた人は、２バイトでのプロシージャ名はやめたほうがよいです。

編集の際に、バージョンによって文字化けが発生し編集しにくくなることに気が付きました。だから「いけない」とはいいません。ただ、システムなど作る場合は、２バイト文字では、後々、設計自体が面倒になってきます。たぶん、その文字化けは、Excel VBE 側のバグなのかもしれません。

また、

私でしたら、

hmsg(Time) & Chr(10) & messe(Time)

このように、Time関数やDate 関数は、一旦変数で受けます。

その分、ユーザー定義関数などでは、ややこしくなりますが、そのほうが後々分かりやすくなります。これ自体は、スタイルですし、2つのTime 関数のタイムラグを言えるほど、Excelは厳密ではありませんが、なんとなく不自然さを感じます。

こんなところだと思います。

お礼

いつもお世話になります。
貴重なご指摘を有難うございました。

回答No.5

imogasi

VBAでもVLOOUUP関数のTRUE型を使えると思います。小生も回答にFALSEは良く使います。
CaseはIf文に近いのでしょうが、この質問コーナーの他の質問でも、IFを並べて（ネストして）関数を考える方が多いですが、私は進歩が無いと思って
VLOOKUPや　表引きロジックを使うよう説いています。
Application.WorkSheetFunction.Vlookup(・・
質問例に私は賛同できませんので、イメージがわかず、模擬実例とコードをあげられませんが、VLOOKUPを検討してみてください。

お礼

ありがとうございます。

回答No.4

makohyu

この関数には、問題点があるみたいですね？

原因は、MsgBox hmsg(Time) & Chr(10) & messe(Time), ・・・と
Timeを２箇所に使っていることです。

相当小さな確率ですが、hmsg(Time) と messe(Time) のTimeの時間が違う場合があるので、正午をまたいでそれぞれが取得されると、「おはようございます。１２時を回りましたね。 。(^o^)/」と表示される場合が出来てしまう可能性があります。

ご愛嬌としては何も問題はありません。

変数にTimeで１度だけ時間を取得して、その変数を渡すようにするといいのですが、好みの問題でもあります。。。。

Functionプロシージャが２つになってしまっていることについても、個人のレベルでなら、いいんじゃないですか？

ただ、わたしなら、挨拶testのなかでまとめますが。。。

２つのプロシージャを他で別々に使う必要があればそれでいいのですが、おそらくあまりないような気がします。

参考になりましたら、幸いです。

お礼

> hmsg(Time) と messe(Time) のTimeの時間が違う場合があるので

考えても見ませんでした。
ありがとうございます。

> わたしなら、挨拶testのなかでまとめますが。。。

何箇所かで使いたかったので一つのFunctionにしたかったのです。

回答No.3

noname#140971

バグは取っていません。
が、バグをとれば動く筈です。

Sub 挨拶test()
　　MsgBox hmsg(Time) & Chr(10) & messe(Time), , "*・゜゜・*:.。. .。.:*・゜゜・*"
End Sub

Function messe(Jikan) As String
　　Dim T(2) As Integer

　　T(0) = Hour(Jikan)
　　T(1) = Hour(TimeValue(Jikan) + TimeValue("01:00"))
　　T(2) = Minute(T)
　　messe = CutStr(T(1) & "時を回りましたね。 。(^o^)/|| " & _
　　　　　 "もうすぐ" & t2 & "時半になりますね。 (〃^∇^〃)||" & _
　　　　　 t2 & "時半を過ぎてますね。 (=´▽｀）ゞ||" & _
　　　　　 "もうすぐ" & t3 & "時になるんですね。（＾∇＾）", _
　　　　　 (T(2) < 15) + (T(2) > 14 And T(2) < 30) * 2 + (T(2) > 29 And T(2) < 45) * 3 + (T(2) > 44) * 4)
End Function

Function hmsg(Jikan) As String
　　Dim T As Integer

　　T = Hour(Jikan)
　　hmsg = UCase(Environ("UserName")) & "さん、" & _
　　　　　 CutStr("おはようございます/こんにちは/こんばんは。", _
　　　　　 "/", _
　　　　　 (T <= 11) + (T > 11 And T < 17) * 2 + (T > 17) * 3)
End Function

Public Function CutStr(ByVal Text As String, _
　　　　　　　　　　　 ByVal Separator As String, _
　　　　　　　　　　　 ByVal N As Integer) As String
　　Dim strDatas() As String

　　strDatas = Split("" & Separator & Text, Separator, , 0)
　　CutStr = strDatas(N * Abs((N <= UBound(strDatas))))
End Function

お礼

残念ながらわたしにはバグが取れませんでした・・・・。
インデックスが有効範囲にないと出てしまいます。