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

回答No.4

okormazd · ベストアンサー

要するに関数で、複数の値を返したいらしいので、
たとえば、グローバル変数で渡すとか、
次のようにするとか。

Sub test01()
MsgBox messe(TimeValue("17:46"), rhmsg, rmes, rs, rkaoi)
MsgBox rhmsg & " " & rmes & " " & rs & " " & rkaoi
End Sub

Function messe(t As Date, ByRef hmsg, ByRef mes, ByRef s, ByRef kaoi)

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)
kaoi = kao(i)
'MsgBox messe(0), messe(1), messe(2), messe(3)

End Function

お礼

有難うございます。
無事出来ました。
補足欄にも書きましたが

MsgBox messe(TimeValue("17:46"), hmsg, mes, s, kaoi) を行なわない場合は、Call　messe(TimeValue("21:46"), hmsg, mes, s, kaoi)とすればいいんですね？

rhmsg, rmes, rs, rkaoi　と、Function側に無いｒを頭につけたのはどういう理由なのでしょうか？

補足

Option Explicit

Sub test01()
Dim hmsg As String, mes As String, s As String, kaoi As String
Call messe(TimeValue("17:46"), hmsg, mes, s, kaoi)
MsgBox hmsg & " " & mes
MsgBox s & " " & kaoi
MsgBox messe(TimeValue("21:46"), hmsg, mes, s, kaoi)
End Sub

Function messe(t As Date, ByRef hmsg, ByRef mes, ByRef s, ByRef kaoi)

Dim t2 As Integer, t3 As Integer, m As Integer, i As Integer, n As Integer
Dim kao

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)
kaoi = kao(i)

End Function

としてみました。
MsgBox messe(TimeValue("17:46"), hmsg, mes, s, kaoi) を行なわない場合は、Call　messe(TimeValue("21:46"), hmsg, mes, s, kaoi)とすればいいんですね？

rhmsg, rmes, rs, rkaoi　と、Function側に無いｒを頭につけたのはどういう理由なのでしょうか？

回答No.8

kobouzu_su

>わたしももっと何とかならないかと考えておりまして補足欄のように修正したのですが、これならおかしくないですか？

　　Great Job!!(^o^)/

これを機会に変数のスコープ（超重要）、引数についてしっかりと身につけませう。
何事も基本を抑えておくことが大事です。

●「魔王」
こちらでもなかなか手に入らぬものです。
それをちびりちびりと？　ええですねぇ。
が、飲み過ぎにはくれぐれもご注意！！(^^;;;

お礼

kobouzu_su大師さま、いつもお世話になり有難うございます。
とても勉強になりました。
これからもよろしくご指導ください。
ご旅行気をつけて！

回答No.7

Wendy02

こんにちは。

だいたい、こんな感じにしたら、簡単でよいかと思います。
配列の数自体がもう決まってしまっていますから、それを予め作っておいて、それに代入すればよいです。

Sub test02()
　　Dim arr() As Variant　'←*
　　Dim hmsg As String, mes As String, s As String, kaoi As String, n As Integer
　　arr() = messe(TimeValue("17:46"))
　　For n = LBound(arr) To UBound(arr)
　　　　MsgBox arr(n)
　　Next n
End Sub

Function messe(t As Date) As Variant
'または、Function messe(t As Date) As Variant()　''配列しか出力しない時

　　Dim t2 As Integer, t3 As Integer, m As Integer, i As Integer
　　Dim hmsg As String, mes As String, s As String
　　Dim kao As Variant
　　Dim arr(3) As Variant　'加えた
　　'--省略--

　　　　Randomize
　　i = Int(Rnd() * 14)
　　arr(0) = hmsg
　　arr(1) = mes
　　arr(2) = s
　　arr(3) = kao(i)

　　messe = arr()
End Function

お礼

Wendy02さま、いつもいつも有難うございます。
とても勉強になりました。
これからもよろしくご指導ください。

回答No.6

kobouzu_su

おひさです。
エクスパート様におかれましては、
２６日からのゴールデンウィーク、いかがお過ごしでしょうか。
まさか、お仕事などされているのではないでせうねぃ？(^_^;;;

スーパーエキスパートのWendy02さんが登場されてますから出る幕ないのですが、折角ですので参考程度に一言。

Wendy02さんへの補足提示のコードは、もうFunctionステートメントの態をなしておりませぬね。
何故なら、戻り値がありません。(^^;;;
配列に値が戻ってきてるじゃないか、などとは言わないでくださいねぃ。

ま、それは置いといて。

補足提示のコードでの、変数Arrは、モジュール変数になっていますのでそれはそれでＯＫです。
が、なるべくなら変数はそのスコープが狭い範囲のものを使うのが基本ですから。。。

'--------------------------------------
Option Explicit

　　Dim Arr　　'▼省く

'-------------------------------------
Sub test01()
　Dim n As Integer

　Dim Arr　　'●ここで宣言

　Call Messe(TimeValue("17:46"), Arr)　　'●arrを引数に入れる

　For n = LBound(Arr) To UBound(Arr)
　　　MsgBox arr(n)
　Next n
End Sub

'------------------------------------------

　Function Messe(t As Date, Arr) As Variant　　'●　引数にいれる

　　以下、略。。

'------------------------------------------

■先にも言いましたが補足提示のコードは、Subステートメントがよろしいかと。

　Sub Messe(t As Date, Arr)

　　以下、略。。　
'-----------------------------------------------------

■努力目標■
今度のゴールデンウィークはどこへも行かないで
変数のスコープ、Sub,Functionステートメント及びその引数
これらをものにするために費やしませう。(^o^)

因みに当方は、２～６日、博多の人、京都の人になりまする。(^o^)/
以上です。

お礼

大師さま、おひさしぶりでございます。
GWはカレンダーどおりの出勤です。昨日はお休みでしたが、今日も一昨日も会社です。博多に京都ですか、いいですねえ。
わたしのGWは先日入手した「魔王」を少しずついただくくらいです。

今回もご教示ありがとうございました。
わたしももっと何とかならないかと考えておりまして補足欄のように修正したのですが、これならおかしくないですか？
ご教示くださりませ。

補足

こちらでも修正をしておりました。
これならFunctionステートメントの態をなすでしょうか？

Sub test01()
Dim Arr
Dim n As Integer
Arr = Messe(TimeValue("17:46"))
For n = LBound(Arr) To UBound(Arr)
MsgBox Arr(n)
Next n
End Sub

Function Messe(t As Date) As Variant

Dim t2 As Integer, t3 As Integer, m As Integer, i As Integer
Dim hmsg As String, mes As String, s As String
Dim kao

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 = Array(hmsg, mes, s, kao(i))
End Function

回答No.5

Wendy02

こんにちは。

>Functionから ”messe” として返ってくる文字列を、Function内部で生成している、”>hmsg”、”mes”、”s”、”kao(i)” にわけて取得できないかということです。

あえて、コードを書く必要はないと思いますが、Function の戻り値　を、#1さんのご指摘のように、参照渡しするか、配列にするか、構造体にすればよいのではありませんか。

私個人は、参照渡しを使う方法が一番多いですね。理由は、サブルーチンにして呼び出しで使うわけですから、二つのプロシージャ内で、変数は、共有していくからですね。変数名自体も共有しますから、コードがなんと言っても、読みやすいです。ただし、手抜きならともかく、まともに書くと、変数と引数のデータ型が指定されるのが玉にキズというところかな。

お礼

有難うございます。

> 参照渡しするか、配列にするか、構造体にすればよいのではありませんか。

参照渡しはなんとか出来ましたので配列に挑戦しました。
補足欄に書きましたがこれでいいのでしょうか？
Dim arrを　一番上で宣言（これがグローバル変数でしたっけ？）しないとFunctionから持って来れないので違うような気がします。
再度ご教示いただければ幸いです。

補足

以下で一応動いてます。

Option Explicit
Dim arr

Sub test01()
Dim hmsg As String, mes As String, s As String, kaoi As String, n As Integer
Call messe(TimeValue("17:46"))
For n = LBound(arr) To UBound(arr)
MsgBox arr(n)
Next n
End Sub

Function messe(t As Date) As Variant

Dim t2 As Integer, t3 As Integer, m As Integer, i As Integer
Dim hmsg As String, mes As String, s As String
Dim kao

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)
arr = hmsg & "," & mes & "," & s & "," & kao(i)
arr = Split(arr, ",")
End Function

回答No.3

noname#140971

後半が抜けていました。

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

プログラムはシンプルが一番だと思います。

回答No.2

noname#140971

おはようございます。XX時を回りましたね。とうとう日付が変わりました。o(^o^)/,(*^o^*),｀*)
おはようございます。XX時を回りましたね。からだに気をつけてね。o(^o^)/,(*^o^*),｀*)
おはようございます。XX時を回りましたね。からだに気をつけてね。o(^o^)/,(*^o^*),｀*)
おはようございます。XX時を回りましたね。からだに気をつけてね。o(^o^)/,(*^o^*),｀*)

と、普通は、このような Greeting.txt を用意すると思います。
つまり、本来はブラックボックスである関数中にデータを埋め込むことをこれで回避できます。
挨拶文に手直しがあれば、メモ帳で編集すれば事足りる訳です。

さて、こういう場合、MyGreeting()、CutStr() の二つを用意すれば目的は達成できます。

[イミディエイト]
? MyGreeting(0)
おはようございます。XX時を回りましたね。とうとう日付が変わりました。o(^o^)/,(*^o^*),｀*)
? MyGreeting(1)
おはようございます。XX時を回りましたね。からだに気をつけてね。o(^o^)/,(*^o^*),｀*)
? Replace(MyGreeting(0), "XX", "00:00")
おはようございます。00:00時を回りましたね。とうとう日付が変わりました。o(^o^)/,(*^o^*),｀*)
? Replace(MyGreeting(1), "XX", "01:00")
おはようございます。01:00時を回りましたね。からだに気をつけてね。o(^o^)/,(*^o^*),｀*)
? CutStr(Replace(MyGreeting(1), "XX", "01:00"), "。", conHMSG)
おはようございます
? CutStr(Replace(MyGreeting(1), "XX", "01:00"), "。", conMES)
01:00時を回りましたね
? CutStr(Replace(MyGreeting(1), "XX", "01:00"), "。", conS)
からだに気をつけてね
? CutStr(Replace(MyGreeting(1), "XX", "01:00"), "。", conKAO)
o(^o^)/,(*^o^*),｀*)

MyGreeting()なんてDIM文も含めても僅かに３行。
CutStr() もDIM文も含めても僅かに３行。

Public Const conGREEETINGTEXT = "C:\Temp\Greeting.txt"
Public Const conHMSG = 1
Public Const conMES = 2
Public Const conS = 3
Public Const conKAO = 4

Public Function FileReadArray(ByVal FileName As String) As String()
On Error GoTo Err_FileReadArray
　　Dim fso As Object
　　Dim strTexts() As String

　　Set fso = CreateObject("Scripting.FIleSystemObject")
　　strTexts() = Split(fso.OpenTextFile(FileName).ReadAll, vbCrLf)
Exit_FileReadArray:
　　FileReadArray = strTexts()
　　Exit Function
Err_FileReadArray:
　　MsgBox Err.Description & "(FileReadArray)", vbExclamation, " 関数エラーメッセージ"
　　strTexts() = Split("")
　　Resume Exit_FileReadArray
End Function

Public Function MyGreeting(ByVal index As Integer) As String
　　Dim strGreeting() As String

　　strGreeting() = FileReadArray(conGREEETINGTEXT)
　　MyGreeting = strGreeting(index)
End Function

お礼

有難うございます。
すみません、わたしにはまだ高度すぎてついていけないようです。

回答No.1

higekuman

質問の意味があまりよく解っていないので、的外れな回答かもしれません。

Functionは、1つの値しか返せません。

ちょっと角度を変えて・・・

サブルーチンの引数を、値渡し(ByVal)ではなく、参照渡し(ByRef)にすることによって、いくつもの値を返す関数として利用できます。

例：

Sub test1(ByRef aaa, ByRef bbb, ByRef ccc)

aaa = 5
bbb = "test"
ccc = 2.8

End Sub

Sub test2()

Dim aaa, bbb, ccc
aaa = 4
bbb = "temp"
ccc = 5.4

MsgBox aaa & bbb & ccc

Call test1(aaa, bbb, ccc)

MsgBox aaa & bbb & ccc

End Sub

これで、test2を実行してみてください。

お礼

有難うございます。
参照渡し(ByRef)を使えばいいんですね。
出来ました。