Option Explicit

Dim re As New RegExp    '正規表現オブジェクト

'-------------------------------------------
' 勤務名変換関数
'-------------------------------------------

Function Kinmu(No) As String
'
' 番号を勤務名に変換
'
    Kinmu = ""
    No = Val(No) '数値に変換
    With Range("勤務リスト")
        If No >= 1 And No <= .Rows.Count Then
            Kinmu = .Cells(No)
        End If
    End With
    
End Function

Function KinmuNo(Kinmu As String) As Integer ' 勤務名を番号に変換
    KinmuNo = GetKinmu(Kinmu, "勤務番号")
End Function

Function KinmuColor(Kinmu As String) As Long ' 勤務名を背景色に変換
    KinmuColor = GetKinmu(Kinmu, "背景色")
End Function

Function KinmuFontColor(Kinmu As String) As Long ' 勤務名を文字色に変換
    KinmuFontColor = GetKinmu(Kinmu, "文字色")
End Function

Function GetKinmu(Kinmu As String, 取得種別 As String) As Long
'
' 勤務名に応じた情報取得
'
    GetKinmu = -1
    With Range("勤務リスト")
        
        Dim i  As Integer
        For i = 1 To .Rows.Count
            If Strings.Trim(Kinmu) = .Cells(i, 1) Then
                Select Case 取得種別
                    Case "勤務番号": GetKinmu = i
                    Case "背景色":   GetKinmu = .Cells(i, 1).Interior.Color
                    Case "文字色":   GetKinmu = .Cells(i, 1).Font.Color
                    Case Else
                End Select
            End If
        Next i
        
    End With
    
End Function

'-------------------------------------------
' 正規表現
'-------------------------------------------

Function MyRegCount(Src As String, Pattern As String) As Integer
'
' 正規表現による検索
'
' 入力
' 　Src    :検索対象文字列
' 　Pattern:検索正規表現パターン
'
' 戻り値   :見つかった個数
'
    MyRegCount = 0
    
    Dim reMatch As MatchCollection 'マッチ結果格納用オブジェクト

    With re
        .Pattern = Pattern
        .IgnoreCase = True      '大小文字の区別無し
        .Global = True          '文字列全体を検索
        If re.test(Src) Then    'テスト
            Set reMatch = .Execute(Src) '発見
            MyRegCount = reMatch.Count  '個数セット
        End If
    End With
    
End Function


Function MyConnectAll(範囲 As Range, Optional 区切り文字 As String = "", Optional 空白文字 As String) As String
'
' 範囲内の文字列をすべて連結
' 区切り文字：それぞれの文字の間には区切り文字を連結：省略可
' 空白置換　：セルが空白の場合に代わりの文字を入れる

    Dim tmp
    
    MyConnectAll = ""
    For Each tmp In 範囲
        If MyConnectAll <> "" Then MyConnectAll = MyConnectAll & 区切り文字
        If tmp = "" Then tmp = 空白文字
        MyConnectAll = MyConnectAll & tmp
    Next

End Function



Function IsRange(RangeName As String) As Boolean
' 範囲名の正当性チェック
    On Error GoTo MyEnd
    IsRange = False
    If Range(RangeName).Address <> "" Then IsRange = True   'アドレスを取得できたら正しい！
MyEnd:
    On Error GoTo 0
End Function

'-------------------------------------------
' 変換関数
'-------------------------------------------

Function MyReplaceAll(データ, 変換テーブル As Range) As String
'
' 含まれる文字をテーブルをもとにすべて変換
'
    Dim k As Integer
    Dim Tbl
    
    Tbl = 変換テーブル
    MyReplaceAll = データ
    For k = 1 To UBound(Tbl, 1)
        MyReplaceAll = Replace(MyReplaceAll, Tbl(k, 1), Tbl(k, 2))
    Next k

End Function