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

解決済みの質問

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

時間により挨拶の内容を変えるCODEを作りました。一応、当初の目的どおりのは答えを返すのですが、時間と分で2つ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

投稿日時 - 2007-08-03 17:12:31

QNo.3224510

暇なときに回答ください

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

こんにちは。
簡素化という観点から外れて、ちょっと遊んでしまいました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 はちょとおもしろいかも^ ^

投稿日時 - 2007-08-03 23:16:44

お礼

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

投稿日時 - 2007-08-04 14:01:51

ANo.7

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

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

回答(13)

ANo.13

(#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

投稿日時 - 2007-08-07 13:17:19

お礼

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

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

投稿日時 - 2007-08-07 13:35:09

ANo.12

こんにちは。
#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化されたほうが実用的かもしれませんね。
(いや、質問者さんのご判断で構わないとは思いますが^ ^;)

投稿日時 - 2007-08-06 15:54:59

お礼

> 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()側で個別に取得するにはどうするものなのでしょうか?

投稿日時 - 2007-08-07 09:50:48

ANo.11

ついでに・・・

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

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

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

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

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

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

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

投稿日時 - 2007-08-04 19:57:23

お礼

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

投稿日時 - 2007-08-06 14:57:23

ANo.10

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

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

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

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

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

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

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

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

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

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

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

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

投稿日時 - 2007-08-04 18:39:12

補足

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

投稿日時 - 2007-08-06 14:57:58

ANo.9

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

投稿日時 - 2007-08-04 16:20:34

お礼

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

投稿日時 - 2007-08-06 13:58:18

ANo.8

#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

投稿日時 - 2007-08-03 23:32:18

お礼

有難うございました。
何箇所かのメッセージで使うので、以下のような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

投稿日時 - 2007-08-06 15:08:38

ANo.6

こんばんは。

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

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

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

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

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

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

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

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

また、

私でしたら、

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

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

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

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

投稿日時 - 2007-08-03 20:46:57

お礼

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

投稿日時 - 2007-08-04 13:46:58

ANo.5

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

投稿日時 - 2007-08-03 19:15:56

お礼

ありがとうございます。

投稿日時 - 2007-08-04 13:45:07

ANo.4

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

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

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

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

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

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

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

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

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

投稿日時 - 2007-08-03 17:53:15

お礼

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

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

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

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

投稿日時 - 2007-08-04 13:44:12

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

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

投稿日時 - 2007-08-03 17:34:46

お礼

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

投稿日時 - 2007-08-04 13:41:39

ANo.2

Sub 挨拶test()
Hx = Hour(Time)
Mx = Minute(Time)
'時間判定
Select case Hx
Case Is <= 11: hmsg = "おはようございます。"
Case Is < 17: hmsg = "こんにちは。"
Case Else: hmsg = "こんばんは。"
End Select
'分判定
Select Case Mx
Case Is < 15: messe = Hx & "時を回りましたね。 。(^o^)/"
Case Is < 30: messe = "もうすぐ" & Hx & "時半になりますね。 (〃^∇^〃) "
Case Is < 45: messe = Hx & "時半を過ぎてますね。 (=´▽`)ゞ"
Case Else: messe = "もうすぐ" & Hx + 1 & "時になるんですね。(^∇^)"
End Select
'メッセージ表示
MsgBox UCase(Environ("UserName")) & "さん、" & hmsg & Chr(10) & messe, , "*・゜゜・*:.。. .。.:*・゜゜・*"
End Sub

投稿日時 - 2007-08-03 17:30:45

お礼

質問はFunctionの使い方のつもりでしたが、ありがとうございました。

投稿日時 - 2007-08-04 13:40:26

ANo.1

 コードの美しさは個人の主観によって変わるので何とも言えませんが、Functionは複数に(細かく)分かれている方がスマートだと思いますよ。
 組み合わせでいろいろ動かせますから。

投稿日時 - 2007-08-03 17:19:36

お礼

Functionは複数に(細かく)分かれている方がスマートですか?
ありがとうございました。

投稿日時 - 2007-08-04 13:39:00

あなたにオススメの質問