HOME > エクセルVBA > サンプル > UserFunction

UserFunction


【ファイル名】UserFunction.xlsm
【バージョン】Ver 1.0.2
【作成日】2015年02月11日
【更新日】2015年04月22日
【動作確認】Windows 7
【必要なソフト】Microsoft Excel 2010
【ダウンロード】UserFunction.zip
【説明】エクセルで使用するユーザー定義関数のサンプルです。

マイクロソフトのサイトのリンク Application.MacroOptionsで関数の挿入のダイアログに表示されます。
関数の挿入のダイアログ
このサンプルはThisWorkbookモジュールのWorkbook_Openイベントで宣言してます。

Excel 2010以降ではユーザー定義関数の引数の説明を表示できます。Application.MacroOptions関数のArgumentDescriptionsに1次元配列を指定します。
関数の引数のダイアログ

DateTimeModule
Option Explicit
Option Base 1
Option Compare Binary
' 指定した単位の開始日から終了日までの期間を取得します。(単位のYは年数、Mは月数、Dは日数、MDは月と年を無視した日数、YMは年と日を無視した月数、YDは年を無視した日数)
Function 期間計算(開始日 As Date, 終了日 As Date, 単位 As String) As Variant
' DATEDIF 関数
' https://support.office.com/ja-jp/article/DATEDIF-%E9%96%A2%E6%95%B0-39c703d5-c514-4092-83c3-73a8bae5d165
' 単位
'    "Y" 年数
'    "M" 月数
'    "D" 日数
'    "MD" 月と年を無視した日数
'    "YM" 年と日を無視した月数
'    "YD" 年を無視した日数
  期間計算 = Application.Evaluate("=DateDif(""" & Format(開始日, "yyyy/mm/dd") & """,""" & Format(終了日, "yyyy/mm/dd") & """,""" & 単位 & """)")
End Function
' 開始日から終了日までの日数を取得します。(「終了日を含むか」を省略すると日数に終了日を含みます)
Public Function 日数(開始日, 終了日, Optional 終了日を含むか As Boolean = True) As Long
  Dim StartDay As Date, EndDay As Date
  Dim w As Long

  If TypeName(開始日) = "Range" Then
    If TypeName(開始日.Cells(1).Value) = "Date" Then ' 複数のセルを選択している場合は最初のセルとする
      StartDay = 開始日.Cells(1).Value
    ElseIf TypeName(開始日.Cells(1).Value) = "String" Then
      StartDay = DateValue(開始日.Cells(1).Value)
    Else
      StartDay = 開始日.Cells(1).Value ' ◆エラーになるかも?
    End If
  ElseIf TypeName(開始日) = "String" Then
    StartDay = DateValue(開始日)
  Else
    StartDay = 開始日
  End If

  If TypeName(終了日) = "Range" Then
    If TypeName(終了日.Cells(1).Value) = "Date" Then ' 複数のセルを選択している場合は最初のセルとする
      EndDay = 終了日.Cells(1).Value
    ElseIf TypeName(終了日.Cells(1).Value) = "String" Then
      EndDay = DateValue(終了日.Cells(1).Value)
    Else
      EndDay = 終了日.Cells(1).Value ' ◆エラーになるかも?
    End If
  ElseIf TypeName(終了日) = "String" Then
    EndDay = DateValue(終了日)
  Else
    EndDay = 終了日
  End If

  If StartDay < EndDay Then
    日数 = DateDiff("d", StartDay, EndDay)
  Else
    日数 = DateDiff("d", EndDay, StartDay)
  End If
  If 終了日を含むか Then 日数 = 日数 + 1
End Function
' 時間を指定した分単位で丸めます。(分単位を省略した場合は"0:15"です)
Public Function 時間の丸め(時間 As Variant, Optional 分単位 As String = "0:15") As Date
  Dim t As Date

  If TypeName(時間) = "String" Then
    t = TimeValue(時間)
  Else
    t = 時間
  End If
  時間の丸め = Application.WorksheetFunction.MRound(t, TimeValue(分単位))
End Function
' 時間を指定した分単位で切り上げます。(分単位を省略した場合は"0:15"です)
Public Function 時間切り上げ(時間 As Variant, Optional 分単位 As String = "0:15") As Date
  Dim t As Date

  If TypeName(時間) = "String" Then
    t = TimeValue(時間)
  Else
    t = 時間
  End If
  時間切り上げ = Application.WorksheetFunction.Ceiling(t, TimeValue(分単位))
End Function
' 時間を指定した分単位で切り捨てます。(分単位を省略した場合は"0:15"です)
Public Function 時間切り捨て(時間 As Variant, Optional 分単位 As String = "0:15") As Date
  Dim t As Date

  If TypeName(時間) = "String" Then
    t = TimeValue(時間)
  Else
    t = 時間
  End If
  時間切り捨て = Application.WorksheetFunction.Floor(時間, TimeValue(分単位))
End Function
' 日付から曜日(日、月、火、水、木、金、土)を取得します。(日付を省略した場合は今日の日付です)
' 長い曜日名 = Trueの場合は3文字の曜日名で(日曜日、月曜日、火曜日、水曜日、木曜日、金曜日、土曜日)を返します。
Public Function 曜日(Optional 日付 As Variant, Optional 長い曜日名 As Boolean = False) As String
  If IsMissing(日付) Then 日付 = Date
  If 長い曜日名 = True Then
    曜日 = Format(日付, "aaaa")
  Else
    曜日 = Format(日付, "aaa")
  End If
'    曜日 = WeekdayName(Weekday(日付)) ' 日曜日、月曜日、火曜日、水曜日、木曜日、金曜日、土曜日
End Function
' 日付から月の第何週か求めます。(省略した場合は今日の日付です)
Public Function 第何週(Optional 日付 As Variant) As Date
  Dim YYYYMMDD As Date
  Dim w As Long

  If IsMissing(日付) Then
    YYYYMMDD = Date
  ElseIf TypeName(日付) = "Range" Then
    If TypeName(日付.Cells(1).Value) = "Date" Then ' 複数のセルを選択している場合は最初のセルとする
      YYYYMMDD = 日付.Cells(1).Value
    ElseIf TypeName(日付.Cells(1).Value) = "String" Then
      YYYYMMDD = DateValue(日付.Cells(1).Value)
    Else
      YYYYMMDD = 日付.Cells(1).Value ' ◆エラーになるかも?
    End If
  ElseIf TypeName(日付) = "String" Then
    YYYYMMDD = DateValue(日付)
  Else
    YYYYMMDD = 日付
  End If
  w = Weekday(YYYYMMDD, vbSunday)
  第何週 = (Day(YYYYMMDD) - w + 7 + 6) \ 7 ' その週の土曜日を求めて+6し、7で割った商を返します。
End Function
' 生年月日から年齢を求めます。(法律では誕生日の前日に年をとりますですが、この関数は誕生日です)
Public Function 年齢(生年月日 As Variant) As Long
  Dim Today As Date
  Dim Birthday As Date

  Today = Date

  If IsMissing(生年月日) Then
    年齢 = 0
  ElseIf TypeName(生年月日) = "Range" Then
    If TypeName(生年月日.Cells(1).Value) = "Date" Then ' 複数のセルを選択している場合は最初のセルとする
      Birthday = 生年月日.Cells(1).Value
      年齢 = DateDiff("yyyy", Birthday, Today) + (Format(Birthday, "mmdd") > Format(Today, "mmdd")) ' True=-1 False=0
    ElseIf TypeName(生年月日.Cells(1).Value) = "String" Then
      Birthday = DateValue(生年月日.Cells(1).Value)
      年齢 = DateDiff("yyyy", Birthday, Today) + (Format(Birthday, "mmdd") > Format(Today, "mmdd")) ' True=-1 False=0
    Else
      年齢 = 0
    End If
  ElseIf TypeName(生年月日) = "Date" Then
      年齢 = DateDiff("yyyy", 生年月日, Today) + (Format(生年月日, "mmdd") > Format(Today, "mmdd")) ' True=-1 False=0
  ElseIf TypeName(生年月日) = "String" Then
      Birthday = DateValue(生年月日)
      年齢 = DateDiff("yyyy", Birthday, Today) + (Format(Birthday, "mmdd") > Format(Today, "mmdd")) ' True=-1 False=0
  Else
    年齢 = 0
  End If
End Function
' 年が閏年かを判断します。(省略した場合は今年が閏年か判断します)
' 閏年とは400で割り切れるかあるいは、4で割り切れかつ100で割り切れない年です。
Public Function 閏年(OptionalAs Variant) As Boolean
  Dim YYYY As Long ' 年

  If IsMissing(年) Then
      YYYY = Year(Date)
  ElseIf TypeName(年) = "Range" Then
    If TypeName(年.Cells(1).Value) = "Date" Then ' 複数のセルを選択している場合は最初のセルとする
      YYYY = Year(年.Cells(1).Value)
    ElseIf TypeName(年.Cells(1).Value) = "String" Then
      YYYY = Left(年.Cells(1).Value, 4)
    Else
      YYYY = 年.Cells(1).Value
    End If
  ElseIf TypeName(年) = "Date" Then
    YYYY = Year(年)
  ElseIf TypeName(年) = "String" Then
    YYYY = Left(年, 4)
  Else
    YYYY = 年
  End If
  If YYYY < 100 Then YYYY = YYYY + 2000 ' 99年以下は2000年以上とします。

  閏年 = (YYYY Mod 400 = 0) Or ((YYYY Mod 4 = 0) And (YYYY Mod 100 <> 0))
End Function
' 日付から月末を求めます。(省略した場合は今月の月末です)
Public Function 月末(Optional 日付 As Variant) As Date
  Dim YYYYMMDD As Date
  Dim YYYY As Long ' 年
  Dim MM   As Long ' 月

  If IsMissing(日付) Then
    YYYYMMDD = Date
  ElseIf TypeName(日付) = "Range" Then
    If TypeName(日付.Cells(1).Value) = "Date" Then
      YYYYMMDD = 日付.Cells(1).Value ' 複数のセルを選択している場合は最初のセルとする
    ElseIf TypeName(日付) = "String" Then
      YYYYMMDD = DateValue(日付.Cells(1).Value)
    Else
      YYYYMMDD = 日付
    End If
  ElseIf TypeName(日付) = "String" Then
    YYYYMMDD = DateValue(日付)
  Else
    YYYYMMDD = 日付
  End If

  YYYY = Year(YYYYMMDD)
  MM = Month(YYYYMMDD)
  月末 = DateSerial(YYYY, MM + 1, 1) - 1 ' 月末とは翌月の1日の前日(12月でも問題なし)
End Function
' 日付から翌月の月末を求めます。(省略した場合は来月の月末です)
Public Function 翌月の月末(Optional 日付 As Variant) As Date
  Dim YYYYMMDD As Date
  Dim YYYY As Long ' 年
  Dim MM   As Long ' 月

  If IsMissing(日付) Then
    YYYYMMDD = Date
  ElseIf TypeName(日付) = "Range" Then
    If TypeName(日付.Cells(1).Value) = "Date" Then
      YYYYMMDD = 日付.Cells(1).Value ' 複数のセルを選択している場合は最初のセルとする
    ElseIf TypeName(日付) = "String" Then
      YYYYMMDD = DateValue(日付.Cells(1).Value)
    Else
      YYYYMMDD = 日付
    End If
  ElseIf TypeName(日付) = "String" Then
    YYYYMMDD = DateValue(日付)
  Else
    YYYYMMDD = 日付
  End If

  YYYY = Year(YYYYMMDD)
  MM = Month(YYYYMMDD)
  翌月の月末 = DateSerial(YYYY, MM + 2, 1) - 1 ' 月末とは翌月の1日の前日(12月でも問題なし)
End Function
' 年から干支を求めます。(省略した場合は今年の干支です)
Public Function 干支(OptionalAs Variant) As String
  Dim YYYY As Long ' 年

  If IsMissing(年) Then
    YYYY = Year(Date)
  ElseIf TypeName(年) = "Range" Then
    If TypeName(年.Cells(1).Value) = "Date" Then ' 複数のセルを選択している場合は最初のセルとする
      YYYY = Year(年.Cells(1).Value)
    ElseIf TypeName(年.Cells(1).Value) = "String" Then
      YYYY = Left(年.Cells(1).Value, 4)
    Else
      YYYY = 年.Cells(1).Value
    End If
  ElseIf TypeName(年) = "Date" Then
    YYYY = Year(年)
  ElseIf TypeName(年) = "String" Then
    YYYY = Left(年, 4)
  Else
    YYYY = 年
  End If

  干支 = Mid("申酉戌亥子丑寅卯辰巳午未", (YYYY Mod 12) + 1, 1)
End Function

このページの上

StringModule
Option Explicit
Option Base 1
Option Compare Binary

' 文字列のバイト数を取得します。
' エクセルのLENB関数があります。
Public Function LenByte(文字列 As String) As Long
  LenByte = LenB(StrConv(文字列, vbFromUnicode))
End Function
' 半角を全角にします。
' エクセルのJIS関数があります。
Public Function Han2Zen(Han As String) As String
' この関数よりもエクセルのJIS関数を使用した方が良いでしょう。
' StrConvで全角にすると、変換できない場合は半角の「?」になります。(「ア゙」は「ア?」になります)
' この関数は「ア゙」などの変換できない半角の濁音(゙)や半濁音(゚)は全角の濁音(゛)や半濁音(゜)にします。(結合文字にはしません)
  Dim C As String, s As String, h As String
  Dim i As Long, l As Long

  l = Len(Han)
  s = ""
  Han2Zen = ""
  For i = 1 To l
    C = Mid$(Han, i, 1) ' 1文字づつ取得します。
    If C Like "[。-゚]" Then ' 半角カタカナの場合は
      s = s & C ' 濁音や半濁音があるため、まとめてから全角に変換する必要があります。
      If C = "゙" Or C = "゚" Then ' 濁音(゙)や半濁音(゚)
        Han2Zen = Han2Zen & StrConv(s, vbWide)
        h = Right$(Han2Zen, 1) ' 最後の文字
        If h = "?" Then ' 変換できない場合は
          Han2Zen = Left$(Han2Zen, Len(Han2Zen) - 1) ' 最後の文字を削除
          If C = "゙" Then  ' 濁点
            Han2Zen = Han2Zen & "゛" ' 全角の濁点を追加します
          End If
          If C = "゚" Then ' 半濁点
            Han2Zen = Han2Zen & "゜" ' 全角の半濁点を追加します
          End If
        End If
        s = ""
      End If
    Else
      Han2Zen = Han2Zen & StrConv(s & C, vbWide)
      s = ""
    End If
  Next i

  If s <> "" Then ' まだ半角カタカナを変換していない場合は
    Han2Zen = Han2Zen & StrConv(s, vbWide)
  End If
End Function
' 半角のカタカナのみを全角にします。
Public Function HanKana2Zen(Han As String) As String
' 「ア゚」などの変換できない半角の濁音(゙)や半濁音(゚)は全角の濁音(゛)や半濁音(゜)にします。(結合文字にはしません)
' この関数は半角カタカナに記号を含めたUnicodeのFF61-FF9Fの範囲とします。(。)から(゚)まで 【注意】サンプルの多くは「ヲ」から「ン」としてます。
' 。「」、・ヲァィゥェォャュョッーアイウエオカキクケコサシスセソタチツテトナニヌネノハヒフヘホマミムメモヤユヨラリルレロワン゙゚
' この関数では半角カタカナにカナ記号(。「」、・)を含め、半角の空白は含めません。
  Dim C As String, s As String, h As String
  Dim i As Long, l As Long

  l = Len(Han)
  s = ""
  HanKana2Zen = ""
  For i = 1 To l
    C = Mid$(Han, i, 1) ' 1文字づつ取得します。
    If C Like "[。-゚]" Then ' 半角カタカナの場合は
      s = s & C ' 濁音や半濁音があるため、まとめてから全角に変換する必要があります。
      If C = "゙" Or C = "゚" Then ' 濁音(゙)や半濁音(゚)
        HanKana2Zen = HanKana2Zen & StrConv(s, vbWide)
        h = Right$(HanKana2Zen, 1) ' 最後の文字
        If h = "?" Then ' 変換できない場合は
          HanKana2Zen = Left$(HanKana2Zen, Len(HanKana2Zen) - 1) ' 最後の文字を削除
          If C = "゙" Then  ' 濁点
            HanKana2Zen = HanKana2Zen & "゛" ' 全角の濁点を追加します
          End If
          If C = "゚" Then ' 半濁点
            HanKana2Zen = HanKana2Zen & "゜" ' 全角の半濁点を追加します
          End If
        End If
        s = ""
      End If
    Else
      HanKana2Zen = HanKana2Zen & StrConv(s, vbWide) & C
      s = ""
    End If
  Next i

  If s <> "" Then ' まだ半角カタカナを変換していない場合は
    HanKana2Zen = HanKana2Zen & StrConv(s, vbWide)
  End If
End Function
' 指定した漢字のフリガナを取得します。
' エクセルのPHONETIC関数があります。
Public Function フリガナ2(漢字 As String) As String
  フリガナ2 = Application.GetPhonetic(漢字)
'  フリガナ2 = StrConv(Application.GetPhonetic(漢字), vbHiragana) ' 平仮名のふりがなを取得
'  フリガナ2 = StrConv(Application.GetPhonetic(漢字), vbNarrow) ' 半角カタカナのフルガナを取得
End Function
' 指定したセルの漢字のフリガナを取得します。
' 指定したセルのふりがなの設定で全角カタカナではなく、ふりがなや半角カタカナを選択できます。
Public Function フリガナ(セル As Range) As String
  フリガナ = セル.Phonetic.Text
End Function
' 指定した文字が平仮名か判断します。
Public Function ひらがな(文字 As String) As Boolean
' ぁ(U+3041)から平仮名の「よ」と平仮名「り」を組み合わせた「より」(U+309F)までと
' ー(U+30FC)を含みます。
' この関数ではダブルハイフン(U+30A0)を含みません!
  Dim i As Long, l As Long
  Dim C As String

  l = Len(文字)
  ひらがな = False
  For i = 1 To l
    C = Mid$(文字, i, 1)
    If C <> "ー" And (C < "ぁ" Or C > ChrW(&H309F)) Then Exit Function
  Next i
  ひらがな = True
End Function
' 指定した文字が半角カタカナか判断します。
Public Function 半角カタカナ(文字 As String) As Boolean
' 。(U+FF61)から゚(U+FF9F)とします。カナ記号(。「」、・)も含めます。
' 【注意】この関数では「ヲ」(U+FF66)からではありません!
  Dim i As Long, l As Long
  Dim C As String

  l = Len(文字)
  半角カタカナ = False
  For i = 1 To l
    C = Mid$(文字, i, 1)
    If (C Like "[。-゚]") = False Then Exit Function
  Next i
  半角カタカナ = True
End Function
' 指定した文字が全角カタカナか判断します。
Public Function 全角カタカナ(文字 As String) As Boolean
' 中点(U+30FB)と長音記号(U+30FC)を含むダブルハイフン(U+30A0)からコト(U+30FF)と
' カタカナフリガナ拡張(U+31F0からU+31FF)と
' 濁点と半濁点(U+3099からU+309C)を含みます。
' この関数はア行エ(U+1B000)を含みません!
  Dim i As Long, l As Long
  Dim C As String

  l = Len(文字)
  全角カタカナ = False
  For i = 1 To l
    C = Mid$(文字, i, 1)
    If Not ((ChrW(&H30A0) <= C And C <= ChrW(&H30FF)) Or _
            (ChrW(&H31F0) <= C And C <= ChrW(&H31FF)) Or _
            (ChrW(&H3099) <= C And C <= ChrW(&H309C))) Then Exit Function
  Next i
  全角カタカナ = True
End Function
' 指定した文字が漢字か判断します。(簡易版)
Public Function 漢字(文字 As String) As Boolean
' 【注意】日本語以外の文字も含まれます。
' CJK統合漢字     (U+4E00からU+9FCF)を含みます。
' CJK互換漢字     (U+F900からU+FAFF)を含みます。
' CJK統合漢字拡張A(U+3400からU+4DBF)を含みます。
' CJK統合漢字拡張B(U+20000からU+2A6DF)は含みません!
' CJK統合漢字拡張C(U+2A700からU+2B73F)は含みません!
' CJK統合漢字拡張D(U+2B740からU+2B81F)は含みません!
' CJK互換漢字補助 (U+2F800からU+2FA1F)は含みません!
  Dim i As Long, l As Long
  Dim C As String

  l = Len(文字)
  漢字 = False
  For i = 1 To l
    C = Mid$(文字, i, 1)
    If Not ((ChrW(&H4E00) <= C And C <= ChrW(&H9FCF)) Or _
            (ChrW(&HF900) <= C And C <= ChrW(&HFAFF)) Or _
            (ChrW(&H3400) <= C And C <= ChrW(&H4DBF))) Then Exit Function
  Next i
  漢字 = True
End Function
' 指定した文字が半角の小文字の英字か判断します。
Public Function IsLower(文字 As String) As Boolean
  Dim i As Long, l As Long
  Dim C As String

  l = Len(文字)
  IsLower = False
  For i = 1 To l
    C = Mid$(文字, i, 1)
    If Asc(C) < Asc("a") Or Asc(C) > Asc("z") Then Exit Function
  Next i
  IsLower = True
End Function
' 指定した文字が半角の大文字の英字か判断します。
Public Function IsUpper(文字 As String) As Boolean
  Dim i As Long, l As Long
  Dim C As String

  l = Len(文字)
  IsUpper = False
  For i = 1 To l
    C = Mid$(文字, i, 1)
    If Asc(C) < Asc("A") Or Asc(C) > Asc("Z") Then Exit Function
  Next i
  IsUpper = True
End Function
' 指定した文字が全角か判断します。
Public Function 全角(文字 As String) As Boolean
  全角 = (文字 = StrConv(文字, vbWide))
End Function
' 指定した文字が半角か判断します。
Public Function 半角(文字 As String) As Boolean
  Dim i As Long, l As Long
  Dim C As String

  l = Len(文字)
  半角 = False
  For i = 1 To l
    C = Mid$(文字, i, 1)
    If StrComp(C, StrConv(C, vbWide), vbBinaryCompare) = 0 Then Exit Function
  Next i
  半角 = True
End Function
' 文字列がパターンに合うかを返します。
Public Function IsPattern(検索の対象 As String, 検索のパターン As String) As Boolean
' ? ・・・・・ 任意の1文字
' * ・・・・・ 0 個以上の文字
' # ・・・・・ 任意の1桁 (0?9)
' [文字] ・・・ 文字に含まれる任意の1文字 小文字の英字は[a-z]、大文字の英字は[A-Z]、 。「」、・の記号を含む半角カタカナは[。-゚]
' [!文字]・・・ 文字に含まれない任意の1文字
  IsPattern = 検索の対象 Like 検索のパターン
End Function

このページの上

OtherModule
Option Explicit
Option Base 1
Option Compare Binary

' 最小から最大の範囲の整数の乱数を取得します。(省略した場合は1〜10の乱数)
' エクセルのRANDBETWEEN関数があります。
Public Function 乱数(Optional 最小 As Long = 1, Optional 最大 As Long = 10) As Long
  Dim small As Long, big As Long

  small = Application.WorksheetFunction.Min(最小, 最大)
  big = Application.WorksheetFunction.Max(最小, 最大)
  乱数 = Int(Rnd() * (big - small + 1) + small)
End Function
' 住所から都道府県を取得します。
Public Function 都道府県(住所 As String) As String
  If Mid(住所, 4, 1) = "県" Then ' 神奈川県、和歌山県、鹿児島県
    都道府県 = Left(住所, 4)
  ElseIf Mid(住所, 3, 1) = "都" Then ' 東京都
    都道府県 = Left(住所, 3)
  ElseIf Mid(住所, 3, 1) = "道" Then ' 北海道
    都道府県 = Left(住所, 3)
  ElseIf Mid(住所, 3, 1) = "府" Then ' 京都府、大阪府
    都道府県 = Left(住所, 3)
  ElseIf Mid(住所, 3, 1) = "県" Then ' 神奈川県、和歌山県、鹿児島県以外の県
    都道府県 = Left(住所, 3)
  Else
    都道府県 = "" ' 該当なし
  End If
End Function
' 住所から都道府県以外を取得します。
Public Function 都道府県以外(住所 As String) As String
  If Mid(住所, 4, 1) = "県" Then ' 神奈川県、和歌山県、鹿児島県
    都道府県以外 = Mid(住所, 5)
  ElseIf Mid(住所, 3, 1) = "都" Then ' 東京都
    都道府県以外 = Mid(住所, 4)
  ElseIf Mid(住所, 3, 1) = "道" Then ' 北海道
    都道府県以外 = Mid(住所, 4)
  ElseIf Mid(住所, 3, 1) = "府" Then ' 京都府、大阪府
    都道府県以外 = Mid(住所, 4)
  ElseIf Mid(住所, 3, 1) = "県" Then ' 神奈川県、和歌山県、鹿児島県以外の県
    都道府県以外 = Mid(住所, 4)
  Else
    都道府県以外 = 住所 ' 該当なし
  End If
End Function
' 全角か半角のスペースで区切られた文字列から苗字を返します。
Public Function 名字(名前 As String) As String
  Dim p As Long

  p = InStr(1, 名前, " ", vbTextCompare) ' 半角のスペースか、あるいは全角スペース
  If p > 0 Then
    名字 = Left$(名前, p - 1)
  Else
    名字 = 名前 ' スペースがない場合は名字のみが入力されているとします。(フルネームが入力されている場合もありますが?)
  End If
End Function
' 全角か半角のスペースで区切られた文字列から名前を返します。
Public Function 名(名前 As String) As String
  Dim p As Long

  p = InStr(1, 名前, " ", vbTextCompare) ' 半角のスペースか、あるいは全角スペース
  If p > 0 Then
    名 = Mid$(名前, p + 1)
  Else
    名 = "" ' スペースがない場合は名字のみが入力されているとします。(フルネームが入力されている場合もありますが?)
  End If
End Function
' 引数にコメントを指定します。戻り値は0です。
' 関数の中にコメントを入力したい場合があります。エクセルのN関数は二重引用符で囲めば数字も0に変換されます。
Public Function C(コメント As String) As Long
  C = 0
End Function

このページの上


ThisWorkbook
Option Explicit
' ブックを開いた時の処理
Private Sub Workbook_Open()
' https://msdn.microsoft.com/ja-jp/library/office/ff838997.aspx
' Application.MacroOptions(Macro, Description, HasMenu, MenuText, HasShortcutKey, ShortcutKey, Category, StatusBar, HelpContextID, HelpFile, ArgumentDescriptions)
' Macro・・・ユーザー定義関数
' Description・・・説明
' Category・・・マクロ関数の分類(標準の分類は下記の数字など、あるいはユーザーの表示する文字列)
'                1・・・財務
'                2・・・日付/時刻
'                3・・・数学/三角
'                4・・・統計
'                5・・・検索/行列
'                6・・・データベース
'                7・・・文字列操作
'                8・・・論理
'                9・・・情報
'               10・・・コマンド
' ArgumentDescriptions・・・引数の説明の1次元配列。(Excel 2010で追加)
' DateTimeModule
  Dim ad(1 To 3) As String

  On Error Resume Next
' Application.MacroOptionsのArgumentDescriptionsは、Excel 2010以降です。
' Excel 2010以降
  #If VBA7 Then
    ad(1) = "": ad(2) = "Trueの場合は3文字の曜日名で(日曜日、月曜日、火曜日、水曜日、木曜日、金曜日、土曜日)を返します。": ad(3) = ""
    Application.MacroOptions Macro:="曜日", Description:="日付から曜日(日、月、火、水、木、金、土)を取得します。(日付を省略した場合は今日の日付です)", Category:="陶山の関数", ArgumentDescriptions:=ad
    ad(1) = "": ad(2) = "": ad(3) = "Trueは終了日に含み、Falseは含みません。"
    Application.MacroOptions Macro:="日数", Description:="開始日から終了日までの日数を取得します。(「終了日を含むか」を省略すると日数に終了日を含みます)", Category:="陶山の関数", ArgumentDescriptions:=ad
    ad(1) = "": ad(2) = "省略した場合は「0:15」で15分、「0:30」は30分": ad(3) = ""
    Application.MacroOptions Macro:="時間切り上げ", Description:="時間を指定した分単位で切り上げます。(分単位を省略した場合は""0:15""です)", Category:="陶山の関数", ArgumentDescriptions:=ad
    Application.MacroOptions Macro:="時間切り捨て", Description:="時間を指定した分単位で切り捨てます。(分単位を省略した場合は""0:15""です)", Category:="陶山の関数", ArgumentDescriptions:=ad
    ad(1) = "省略した場合は「1」です。": ad(2) = "省略した場合は「10」です。": ad(3) = ""
    Application.MacroOptions Macro:="乱数", Description:="最小から最大の範囲の整数の乱数を取得します。(省略した場合は1〜10の乱数)", Category:="陶山の関数", ArgumentDescriptions:=ad
' Excel 2007以前
  #Else
    Application.MacroOptions Macro:="曜日", Description:="日付から曜日(日、月、火、水、木、金、土)を取得します。(日付を省略した場合は今日の日付です)", Category:="陶山の関数"
    Application.MacroOptions Macro:="日数", Description:="開始日から終了日までの日数を取得します。(「終了日を含むか」を省略すると日数に終了日を含みます)", Category:="陶山の関数"
    Application.MacroOptions Macro:="時間切り上げ", Description:="時間を指定した分単位で切り上げます。(分単位を省略した場合は""0:15""です)", Category:="陶山の関数"
    Application.MacroOptions Macro:="時間切り捨て", Description:="時間を指定した分単位で切り捨てます。(分単位を省略した場合は""0:15""です)", Category:="陶山の関数"
    Application.MacroOptions Macro:="乱数", Description:="最小から最大の範囲の整数の乱数を取得します。(省略した場合は1〜10の乱数)", Category:="陶山の関数"
  #End If

' Excel 2007以前と2010以降共通
  Application.MacroOptions Macro:="年齢", Description:="生年月日から年齢を求めます。(法律では誕生日の前日に年をとりますですが、この関数は誕生日です)", Category:="陶山の関数"
  Application.MacroOptions Macro:="閏年", Description:="年が閏年かを判断します。(省略した場合は今年が閏年か判断します)", Category:="陶山の関数"
  Application.MacroOptions Macro:="月末", Description:="日付から月末を求めます。(省略した場合は今月の月末です)", Category:="陶山の関数"
  Application.MacroOptions Macro:="翌月の月末", Description:="日付の翌月の月末を求めます。(省略した場合は来月の月末です)", Category:="陶山の関数"
  Application.MacroOptions Macro:="干支", Description:="年から干支を求めます。(省略した場合は今年の干支です)", Category:="陶山の関数"
  Application.MacroOptions Macro:="第何週", Description:="日付から月の第何週か求めます。(省略した場合は今日の日付です)", Category:="陶山の関数"
' String
  Application.MacroOptions Macro:="IsLower", Description:="指定した文字が半角の小文字の英字か判断します。", Category:="陶山の関数"
  Application.MacroOptions Macro:="IsUpper", Description:="指定した文字が半角の大文字の英字か判断します。", Category:="陶山の関数"
  Application.MacroOptions Macro:="半角", Description:="指定した文字が半角か判断します。", Category:="陶山の関数"
  Application.MacroOptions Macro:="全角", Description:="指定した文字が全角か判断します。", Category:="陶山の関数"
  Application.MacroOptions Macro:="フリガナ", Description:="指定したセルのフリガナを取得します。", Category:="陶山の関数"
' Other
  Application.MacroOptions Macro:="都道府県", Description:="住所から都道府県を取得します。", Category:="陶山の関数"
  Application.MacroOptions Macro:="都道府県以外", Description:="住所から都道府県以外を取得します。", Category:="陶山の関数"

  Saved = True
  On Error GoTo 0
End Sub

このページの上