• ベストアンサー

エクセル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

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

  • ベストアンサー
  • pauNed
  • ベストアンサー率74% (129/173)
回答No.7

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

merlionXX
質問者

お礼

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

全文を見る
すると、全ての回答が全文表示されます。

その他の回答 (12)

  • mshr1962
  • ベストアンサー率39% (7418/18948)
回答No.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

merlionXX
質問者

お礼

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

全文を見る
すると、全ての回答が全文表示されます。
  • j_nishiz
  • ベストアンサー率26% (183/697)
回答No.1

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

merlionXX
質問者

お礼

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

全文を見る
すると、全ての回答が全文表示されます。

関連するQ&A

  • エクセルVBAのFunctionについて

    エクセル2000です。 以下は、時間を与えれば、それに相当する挨拶が返ってくるFunctionのつもりです。 一応期待通りの働きはしてくれます。 質問は、Functionから ”messe” として返ってくる文字列を、Function内部で生成している、”hmsg”、”mes”、”s”、”kao(i)” にわけて取得できないかということです。 もちろん Functionを複数つくったり、返ってくる文字列”messe”を、”。”の位置を取得してMID関数等で分ければ取得できるのはわかるのですが、そんな手間をかけず、たとえば、MsgBox hmsg のような感じで簡単に ”hmsg”、”mes”、”s”、”kao(i)” それぞれの文字列を取得する方法があったらご教示くださいませ。 Sub test01() MsgBox messe(TimeValue("17:46")) End Sub Function messe(t As Date) As String Dim t2 As Integer, t3 As Integer, m As Integer, i As Integer, n As Integer Dim kao Dim s As String t2 = Hour(t) t3 = Hour(TimeValue(t) + TimeValue("01:00")) m = Minute(t) kao = Split("o(^o^)/,(*^o^*),(*´∇`*),(= ̄▽ ̄=)V,(〃^∇^〃),(=´▽`)ゞ,(^∇^),(〃^∇^)o,ヾ(@⌒ー⌒@)ノ, (#^。^#),o(^-^)o,ヾ(=^▽^=)ノ, \(*^▽^*)/ ,( ̄ー ̄)v", ",") Select Case t2 Case Is < 11: hmsg = "おはようございます。" Case Is < 17: hmsg = "こんにちは。" Case Else: hmsg = "こんばんは。" End Select Select Case m Case Is < 15: mes = t2 & "時を回りましたね。 " Case Is < 30: mes = "もうすぐ " & t2 & "時半になりますね。 " Case Is < 45: mes = t2 & "時半を過ぎてますね。" Case Else: mes = "もうすぐ " & t3 & "時になるんですね。 " End Select Select Case t2 Case 0: s = "とうとう日付が変わりました。 " Case 1, 2, 3, 4: s = "からだに気をつけてね。 " Case 5, 6: s = "朝になっちゃいました。 " Case 7, 8, 9: s = "また一日が始まりましたね。 " Case 10: s = "お昼にはまだもうちょっと・・・。 " Case 11: s = "おなかが空いちゃいました。 " Case 12: s = "お昼ですよ~。 " Case 13: s = "食後は眠くなっちゃいます。 " Case 14: s = "そろそろおやつが欲しいかも。 " Case 15, 16: s = "午後は長いですね。 " Case 17: s = "お疲れさまです。 " Case 18: s = "残業、お疲れさまです。 " Case 19, 20: s = "そろそろ切り上げませんか。 " Case 21, 22: s = "こんな遅くまで大変ですね。 " Case 23: s = "日付が変わっちゃいますよ。 " Case Else: s = "がんばってね。 " End Select Randomize i = Int(Rnd() * 14) messe = hmsg & mes & s & kao(i) End Function

  • VBAでFunctionの使い方

    エクセルのVBAでFunctionの使い方がいまいちよくわかりません。 Function msg() Dim h As Integer h = Hour(Time) Select Case h Case Is < 12: msg = "おはようございます。" Case Is < 17: msg = "こんにちは。" Case Else: msg = "こんばんは。" End Select End Function Sub 挨拶() MsgBox msg End Sub とやってみたら一応正しく動くようですが、これであっているのでしょうか? 他の例などを見るとFunction msg()の()内にも何か入れなければならないようなのですが、わかりません。

  • Functionの使い方が分かりません。

    ACCESS 2013環境でVBAを使用しています。 プログラムが長い上、使用する箇所が多くて困っています。 Functionで、使いたい時だけ呼び出したいのですが うまく行きません。 二つのテキストボックスに入力された、文字を組み合わせて 文字列を生成するプロシージャを作成しています。  txt1の値が、岡山  txt2の値が、オカヤマ の時 先頭の文字列が ア行、続きは _岡山 となるよう AscW関数で文字コードで一度抽出し, select文で判別しています。 コードは --------------------------------------------- Private Sub コマンド1_Click() Dim kanji As String Dim katakana As Integer Dim sento As String Dim hensuu As String kanji = Me.txt1 katakana = AscW(Left(Me.txt2,1)) Select Case katakana Case 12450 To 12458 sento = "ア行" Case 12459 To 12468 sento = "カ行" ~(中略)~    Case Else End Select hensuu = sento & "_" & kanji MsgBox hensuu End Sub --------------------------------------------- となっています。 Select Case文が長いのと、複数のフォーム上で実行させるボタンごとに 同じコードを記述していて、最近Accessの起動が遅くなってきました。 Select文をFunctionから呼び出し、最終的にはモジュールから呼び出しに 書き換えたいのですが、書き方が良く分かりません。 試したコード --------------------------------------------- Function moji(ByRef katakana As Integer,sento As String) Select Case katakana Case 12450 To 12458 sento = "ア行" Case 12459 To 12468 sento = "カ行" ~(中略)~    Case Else End Select End Function Private Sub コマンド1_Click() Dim kanji As String Dim katakana As Integer Dim sento As String Dim hensuu As String kanji = Me.txt1 katakana = AscW(Left(Me.txt2,1)) sento = moji(katakana) hensuu = sento & "_" & kanji MsgBox hensuu End Sub --------------------------------------------- 多分、大きく間違っているのではないかと思うのですが どのように修正したらよいでしょうか

  • エクセルVBA Select Case いついて

    現在時間を判断してあいさつを出すVBAを書こうとしましたがうまくいきません。 どこが悪いのかご教示くださいませ。 Sub メッセージ() Dim MG As String Select Case Time Case Time < "16:00:00" MG = "こんにちは。" Case Time < "12:00:00" MG = "おはようございます。" Case Time >= "16:00:00" MG = "こんばんは。" End Select MsgBox MG End Sub

  • VBA 関数(Function) カッコの後のデータ型は必要?

    Function あ() あ = "あああ" End Function Sub test3() MsgBox あ End Sub と、 Function あ() As String あ = "あああ" End Function Sub test3() MsgBox あ End Sub は同じ動作をするのですがやはり「As String」をつけたほうがいいのですか? ウォッチウインドウで確認すると 「As String」がないほうは「Variant/ String」型ですが あるほうは「String」型のみです。

  • ▲ExcelのVBA▼困っています

    何度もVBAで質問させてもらい助けてもらっています。 懲りずにまた質問ですが… 下のプログラムは"●"が跳ね返るものなのですが… ●の後を■と▲が追うようなプログラムにするには なにを追加すればいいのでしょうか…?; どなたか教えて下さい;;お願いします;; Dim time1 As Integer, time As Integer Dim X As Integer, Y As Integer Dim maru As String, yoko As String, tate As String Sub 描画() Cells(X, Y).Value = maru End Sub Sub 削除() Cells(X, Y).Value = "" End Sub Sub 待機() For time1 = 0 To 1000 For time2 = 0 To 1000 Next Next End Sub Sub 座標移動() If yoko = "右" Then Y = Y + 1 Else Y = Y - 1 End If If Y = 30 Then yoko = "左" ElseIf Y = 1 Then yoko = "右" End If If tate = "上" Then X = X + 1 Else X = X - 1 End If If X = 20 Then tate = "下" ElseIf X = 1 Then tate = "上" End If End Sub Sub main() maru = "●" X = 1 Y = 1 yoko = "右" tate = "上" Do 描画 待機 削除 待機 座標移動 Loop End Sub

  • 時間帯の識別がしたいのですが…

    呼出されて勤務した時間帯を管理したいのですが selectcase文で18:00から2:00まで勤務したら『準夜-深夜』と表記したいのですが『型が合いません』とエラーが出ます マクロは我流で勉強中なのでよろしくお願いします Dim 開始時間 As Date, 終了時間 As Date Dim 開始時間帯 As String, 終了時間帯 As String, 業務時間帯 As String Private Sub 業務ステータス() 開始時間 = TimeValue(開始時間TextBox.Text) 終了時間 = TimeValue(終了時間TextBox.Text) Select Case 開始時間 Case 開始時間 > TimeValue("8:29") And 開始時間 < TimeValue("17:00"): 開始時間帯 = "日勤" Case 開始時間 > TimeValue("16:59") And 開始時間 < TimeValue("24:00"): 開始時間帯 = "準夜" Case 開始時間 > TimeValue("0:00") And 開始時間 < TimeValue("8:30"): 開始時間帯 = "深夜" Case 開始時間 = TimeValue("0:00"): 開始時間帯 = "深夜" End Select Select Case 終了時間 Case 終了時間 > TimeValue("8:29") And 終了時間 < TimeValue("17:00"): 終了時間帯 = "日勤" Case 終了時間 > TimeValue("16:59") And 終了時間 < TimeValue("24:00"): 終了時間帯 = "準夜" Case 終了時間 > TimeValue("0:00") And 終了時間 < TimeValue("8:30"): 終了時間帯 = "深夜" Case 終了時間 = TimeValue("0:00"): 終了時間帯 = "深夜" End Select If 開始時間帯 = 終了時間帯 Then 業務時間帯 = 開始時間帯 Else 業務時間帯 = 開始時間帯 & "-" & 終了時間帯 End If End Sub

  • Excel VBA ・・・教えてください

    何度も質問させて頂いてます。すみません、 下記のプログラムはこの場で教えて頂いたプログラムで、 実行すると●の後を▲や■が追いかける動きをします。 下記のプログラムをある程度使用して 1~20の数字が順々で追いかけっこする プログラムを作成するにはどのようにすればいいのでしょうか… できればプログラムは長めにならず 20の数字から簡単に増やすことのできるような そんなプログラムが作成したいです… どなたかアドバイスお持ちの方 教えて下さいお願いします... Dim time1 As Integer, time As Integer Dim X As Integer, Y As Integer Dim X1 As Integer, Y1 As Integer Dim X2 As Integer, Y2 As Integer Dim maru As String, yoko As String, tate As String Dim sankaku As String, shikaku As String Sub 描画() Cells(Y2, X2).Value = shikaku Cells(Y1, X1).Value = sankaku Cells(Y, X).Value = maru End Sub Sub 削除() Cells(Y2, X2).Value = "" End Sub Sub 待機() For time1 = 0 To 1000 For time2 = 0 To 1000 Next Next End Sub Sub 座標移動() X2 = X1 Y2 = Y1 X1 = X Y1 = Y If yoko = "右" Then X = X + 1 Else X = X - 1 End If If X = 30 Then yoko = "左" ElseIf X = 1 Then yoko = "右" End If If tate = "上" Then Y = Y + 1 Else Y = Y - 1 End If If Y = 20 Then tate = "下" ElseIf Y = 1 Then tate = "上" End If End Sub Sub main() maru = "●" sankaku = "▲" shikaku = "■" X = 1 Y = 1 X1 = 1 Y1 = 1 X2 = 1 Y2 = 1 yoko = "右" tate = "上" Do 描画 待機 削除 待機 座標移動 Loop End Sub

  • Excel VBAで変数が定義されていません。

    このシートコードで「変数が定義されていません。」となります。どうすればいいでしょうか。 Private Sub Worksheet_SelectionChange(ByVal Target As Range) Select Case Target.Address Case "$C$10:$C$13" SendKeys "%{DOWN}" Case "$H$10:$H$13" SendKeys "%{DOWN}" Case Else Exit Sub End Select Cancel = True End Sub

  • ファンクションキーで命令を実行させたい

    よろしくお願いします。 ACCESS2000を使用しています。 ファンクションキーで命令を実行したく、下記のコマンドを書いて実行しましたが動作しません。 Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer) Me.メインsub.Form.SetFocus Select Case KeyCode Case vbKeyF5 Me.btn帰社.SetFocus Call btn帰社_Click Case Else KeyCode = 0 End Select End Sub Private Sub Form_Load() Me.KeyPreview = True End Sub フォームプロパティのキーボードイベント取得は「はい」で設定してあります。 2週間位、いろいろやってみましたがうまくいきません。はまっています。回答・ヒントをよろしくお願いします。

専門家に質問してみよう