excelのvbaで、HashMap(連想配列)や可変長配列、数値形式確認、日付形式確認、正規表現、値渡し

久しぶりにexcel vbaのマクロを書いたら、いろいろ忘れてたので、メモ。

ポイントはsrcと、src内のコメントの通り

'変数宣言を必須にするおまじない
Option Explicit

Dim inputSheetDev As Worksheet '開発系テーマの入力シート
Dim inputSheetOpt As Worksheet '運用系テーマの入力シート
Dim startDateIni As Date ' 集計開始日
Dim endDateIni As Date   ' 集計最終日
Dim uriDateIni As Date   ' 売上実績基準
Dim dataBarMax As Long    'データバーの最大値
Dim dataBarMaxSum As Long 'データバーの最大値(合計用)


Sub CalcJuchuuUriageSummary()
    If InitGlobalVals("はじめに") = False Then
        MsgBox "設定内容誤りの可能性で、処理開始できません"
        Exit Sub
    End If

    '#### シートの追加と、印刷設定(用紙サイズやマージン)
    Dim newSheet As Worksheet
    Set newSheet = Worksheets.Add
    Dim tmpCo As Variant
    tmpCo = setSheetFormat(newSheet)
    
   
    Dim rowCo As Integer
    Dim colCoL As Integer
    Dim colCoR As Integer
    Dim tmpCoL As Variant
    Dim tmpCoR As Variant
    Dim summary As Object
    
    '#### 開発・委託系テーマのworksheetの読み取り(parse)
    Dim inputRows As Collection
    Set inputRows = ParseInputSheet(inputSheetDev)
    'チームリーダ名を抽出
    Dim tmLeaders() As Variant
    tmLeaders = extractTmleaders(inputRows)
       
    '受注計画
    Set summary = CalcJuchuuPlans(inputRows, startDateIni, endDateIni)
    '集計結果の出力
    rowCo = 2
    colCoL = 1
    newSheet.Cells(rowCo, colCoL).Value = "■" & inputSheetDev.name & " ＜受注 計画＞"
    tmpCoL = writeTbl(newSheet, summary, tmLeaders, startDateIni, endDateIni, rowCo + 1, colCoL)
    
    '受注実績
    Set summary = CalcJuchuuDones(inputRows, startDateIni, endDateIni)
    '集計結果の出力
    colCoR = tmpCoL(2) + 3
    newSheet.Cells(rowCo, colCoR).Value = "■" & inputSheetDev.name & " ＜受注 実績＞"
    tmpCoR = writeTbl(newSheet, summary, tmLeaders, startDateIni, endDateIni, rowCo + 1, colCoR)
    '計画実績の差異を出力
    tmpCo = writeTblDiff(newSheet, rowCo + 1, tmpCoL(1), tmpCoL(2), tmpCoR(2))

    '売上計画
    Set summary = CalcUriagePlans(inputRows, startDateIni, endDateIni)
     '集計結果の出力
    rowCo = tmpCoL(1) + 4
    newSheet.Cells(rowCo, colCoL).Value = "■" & inputSheetDev.name & " ＜売上 計画＞"
    tmpCoL = writeTbl(newSheet, summary, tmLeaders, startDateIni, endDateIni, rowCo + 1, colCoL)
    
    '売上実績
    Set summary = CalcUriageDones(inputRows, startDateIni, uriDateIni)
    '集計結果の出力
    newSheet.Cells(rowCo, colCoR).Value = "■" & inputSheetDev.name & " ＜売上 実績＞"
    tmpCoR = writeTbl(newSheet, summary, tmLeaders, startDateIni, endDateIni, rowCo + 1, colCoR)
    '計画実績の差異を出力
    tmpCo = writeTblDiff(newSheet, rowCo + 1, tmpCoL(1), tmpCoL(2), tmpCoR(2))


    '#### 専任・運用系テーマのworksheetの読み取り(parse)
    Set inputRows = ParseInputSheet(inputSheetOpt)

    '売上計画
    Set summary = CalcUriagePlans(inputRows, startDateIni, endDateIni)
    '集計結果の出力
    rowCo = tmpCoL(1) + 4
    newSheet.Cells(rowCo, colCoL).Value = "■" & inputSheetOpt.name & " ＜売上 計画＞"
    tmpCoL = writeTbl(newSheet, summary, tmLeaders, startDateIni, endDateIni, rowCo + 1, colCoL)
    
    '売上実績
    Set summary = CalcUriageDones(inputRows, startDateIni, uriDateIni)
    '集計結果の出力
    newSheet.Cells(rowCo, colCoR).Value = "■" & inputSheetOpt.name & " ＜売上 実績＞"
    tmpCoR = writeTbl(newSheet, summary, tmLeaders, startDateIni, endDateIni, rowCo + 1, colCoR)
    '計画実績の差異を出力
    tmpCo = writeTblDiff(newSheet, rowCo + 1, tmpCoL(1), tmpCoL(2), tmpCoR(2))

End Sub

Function InitGlobalVals(ByVal setupSheetName As String) As Boolean
    InitGlobalVals = False

    If ExistWorksheet(setupSheetName) = False Then
        MsgBox "設定用シート：" & setupSheetName & " がありません"
        Exit Function
    End If
    
    Dim setupSheet As Worksheet
    Set setupSheet = Worksheets(setupSheetName)
    
    Dim sheetName As String
    sheetName = setupSheet.Cells(4, 2).Value
    If ExistWorksheet(sheetName) = False Then
        MsgBox "開発・委託系用シート：" & sheetName & " がありません"
        Exit Function
    End If
    Set inputSheetDev = Worksheets(sheetName)
    
    sheetName = setupSheet.Cells(5, 2).Value
    If ExistWorksheet(sheetName) = False Then
        MsgBox "専任・運用系用シート：" & sheetName & " がありません"
        Exit Function
    End If
    Set inputSheetOpt = Worksheets(sheetName)
    
    
    Dim dateStr As String
    dateStr = setupSheet.Cells(6, 2).Value
    If IsDate(dateStr) = False Then
        MsgBox "日付：" & dateStr & " が不正です"
        Exit Function
    End If
    startDateIni = dateStr
    
    dateStr = setupSheet.Cells(7, 2).Value
    If IsDate(dateStr) = False Then
        MsgBox "日付：" & dateStr & " が不正です"
        Exit Function
    End If
    endDateIni = dateStr
    
    dateStr = setupSheet.Cells(8, 2).Value
    If IsDate(dateStr) = False Then
        MsgBox "日付：" & dateStr & " が不正です"
        Exit Function
    End If
    uriDateIni = dateStr

    dataBarMax = 50000
    dataBarMaxSum = 100000

    InitGlobalVals = True
End Function


' 売上実績の集計
Function CalcUriageDones(ByVal inputRows As Collection, _
                         ByVal startDate As Date, ByVal endDate As Date) As Object
    Dim summary As Object
    Set summary = CreateObject("Scripting.Dictionary")
        
    Dim i As Integer
    
    For i = 1 To inputRows.Count
        Dim inputRow As Object
        Set inputRow = inputRows(i)
        Dim tmpDate As Date
        tmpDate = startDate
        
        Do While tmpDate <= endDate
            Dim dateStr As String
            dateStr = tmpDate
            
            If inputRow("確度") = "売" And inputRow.Exists(dateStr) Then
                Dim tmLeader As String
                tmLeader = convTantou2Leader(inputRow("SK"))
                Dim yyyymm As String
                yyyymm = ConvDate2Str(tmpDate)
                Set summary = AddPrice2Hash(summary, tmLeader, yyyymm, inputRow(dateStr))
            End If
        
            tmpDate = DateAdd("m", 1, tmpDate)
        Loop
    Next
    
    Set CalcUriageDones = summary
End Function

Function writeTbl(ByVal newSheet As Worksheet, ByVal summary As Object, _
                  ByVal tmLeaders As Variant, _
                  ByVal startDate As Date, ByVal endDate As Date, _
                  ByVal rowCo As Integer, ByVal colCo As Integer) As Integer()
    Dim rowCoTmp As Integer
    Dim colCoTmp As Integer
    '最左列の見出し
    rowCoTmp = writeTblLcaption(newSheet, startDate, endDate, rowCo, colCo)
    
    'チーム別の成績
    Dim i As Integer
    colCoTmp = colCo
    For i = 0 To UBound(tmLeaders)
        colCoTmp = colCoTmp + 1
        rowCoTmp = writeTblBody(newSheet, summary, tmLeaders(i), startDate, endDate, rowCo, colCoTmp)
    Next
    '最左列に合計
    rowCoTmp = writeTblSum(newSheet, rowCo, rowCoTmp, colCo + 1, colCoTmp)

    Dim coTmp(2) As Integer
    
     coTmp(1) = rowCoTmp
     coTmp(2) = colCoTmp + 1
     writeTbl = coTmp
End Function

Function CalcUriagePlans(ByVal inputRows As Collection, _
                         ByVal startDate As Date, ByVal endDate As Date) As Object
    Dim summary As Object
    Set summary = CreateObject("Scripting.Dictionary")
    
    Dim i As Integer
    
    For i = 1 To inputRows.Count
        Dim inputRow As Object
        Set inputRow = inputRows(i)
        Dim tmpDate As Date
        tmpDate = startDate
        
        Do While tmpDate < endDate
            Dim dateStr As String
            dateStr = tmpDate
            
            If inputRow.Exists(dateStr) Then
                Dim tmLeader As String
                tmLeader = convTantou2Leader(inputRow("SK"))
                Dim yyyymm As String
                yyyymm = ConvDate2Str(tmpDate)
                If IsNumeric(inputRow(dateStr)) Then ' 数値であることの確認
                    Set summary = AddPrice2Hash(summary, tmLeader, yyyymm, inputRow(dateStr))
                End If
            End If
        
            tmpDate = DateAdd("m", 1, tmpDate)
        Loop
    Next
    
    Set CalcUriagePlans = summary
End Function


Function writeTblDiff(ByVal newSheet As Worksheet, _
                       ByVal rowCo1 As Integer, ByVal rowCo2 As Integer, _
                       ByVal colCo1 As Integer, ByVal colCo2 As Integer) As Integer
    newSheet.Cells(rowCo1, colCo2 + 1).Value = "差"
    
    Dim rowCoTmp As Integer
    For rowCoTmp = rowCo1 + 1 To rowCo2
        newSheet.Cells(rowCoTmp, colCo2 + 1).Value = _
        "=" & Cells(rowCoTmp, colCo2).Address & "-" & Cells(rowCoTmp, colCo1).Address
    Next
    '罫線描画
    rowCoTmp = setTblColFrameLine(newSheet, rowCo1, rowCo2, colCo2 + 1)
    '数値の表示形式設定
    newSheet.Range(Cells(rowCo1, colCo2 + 1), Cells(rowCo2, colCo2 + 1)).NumberFormatLocal _
    = "#,##0_ ;[赤]-#,##0 "
    
    writeTblDiff = rowCo2
End Function


Function writeTblSum(ByVal newSheet As Worksheet, _
                     ByVal rowCo1 As Integer, ByVal rowCo2 As Integer, _
                     ByVal colCo1 As Integer, ByVal colCo2 As Integer) As Integer
    
    newSheet.Cells(rowCo1, colCo2 + 1).Value = "計(千円)"
    
    Dim rowCoTmp As Integer
    For rowCoTmp = rowCo1 + 1 To rowCo2
        newSheet.Cells(rowCoTmp, colCo2 + 1).Value = _
        "=SUM(" & Cells(rowCoTmp, colCo1).Address & ":" & Cells(rowCoTmp, colCo2).Address & ")"
    Next
    '罫線描画
    rowCoTmp = setTblColFrameLine(newSheet, rowCo1, rowCo2, colCo2 + 1)
    '条件付き書式(データバー)設定
    rowCoTmp = setTblColDatabar(newSheet, rowCo1 + 1, rowCo2 - 1, colCo2 + 1, _
                                dataBarMaxSum, xlThemeColorAccent6)
    
    writeTblSum = rowCo2
End Function


Function writeTblBody(ByVal newSheet As Worksheet, ByVal summary As Object, _
                      ByVal tmLeader As String, _
                      ByVal startDate As Date, ByVal endDate As Date, _
                      ByVal rowCo As Integer, ByVal colCo As Integer) As Integer
    newSheet.Cells(rowCo, colCo) = tmLeader
    
    Dim tmpDateStr As String
    Dim rowCoTmp As Integer
    rowCoTmp = rowCo
    Dim price As Long  ' vbaのintegerは扱える最大値が小さい様、オーバーフローする為
    
    Do While startDate < endDate
        tmpDateStr = ConvDate2Str(startDate) ' YYYYMMの文字列に変更
        'hash mapにおけるkeyの存在確認
        If summary.Exists(tmLeader & " " & tmpDateStr) Then
            price = summary(tmLeader & " " & tmpDateStr)
        Else
            price = 0
        End If
        
        rowCoTmp = rowCoTmp + 1
        newSheet.Cells(rowCoTmp, colCo) = price
        
        startDate = DateAdd("m", 1, startDate) '1ヶ月後の日付計算
    Loop
    '合計行
    rowCoTmp = rowCoTmp + 1
    newSheet.Cells(rowCoTmp, colCo) = _
        "=SUM(" & Cells(rowCo + 1, colCo).Address & ":" & Cells(rowCoTmp - 1, colCo).Address & ")"
    '罫線描画
    rowCoTmp = setTblColFrameLine(newSheet, rowCo, rowCoTmp, colCo)
    '数値の表示形式設定
    newSheet.Range(Cells(rowCo + 1, colCo), Cells(rowCoTmp, colCo)).NumberFormatLocal = "#,##0_ "
    '条件付き書式(データバー)設定
    rowCoTmp = setTblColDatabar(newSheet, rowCo + 1, rowCoTmp - 1, colCo, dataBarMax, xlThemeColorAccent5)
    
    writeTblBody = rowCoTmp + 1
End Function

Function writeTblLcaption(ByVal newSheet As Worksheet, _
                          ByVal startDate As Date, ByVal endDate As Date, _
                          ByVal rowCo As Integer, ByVal colCo As Integer) As Integer
    newSheet.Cells(rowCo, colCo).Value = "年月"
    
    Dim rowCoTmp As Integer
    rowCoTmp = rowCo
    
    Do While startDate < endDate
        rowCoTmp = rowCoTmp + 1
        newSheet.Cells(rowCoTmp, colCo).Value = ConvDate2Str(startDate)
        startDate = DateAdd("m", 1, startDate)  '1ヶ月後の日付算出
    Loop
    
    rowCoTmp = rowCoTmp + 1
    newSheet.Cells(rowCoTmp, colCo).Value = "計(千円)"
    '罫線描画
    rowCoTmp = setTblColFrameLine(newSheet, rowCo, rowCoTmp, colCo)
    
    writeTblLcaption = rowCoTmp
End Function

Function extractTmleaders(ByVal inputRows As Collection) As Variant
    Dim tmLeadersHash As Object
    Set tmLeadersHash = CreateObject("Scripting.Dictionary")

    Dim i As Integer
    For i = 1 To inputRows.Count
        Dim inputRow As Object
        Set inputRow = inputRows(i)
        Dim tmLeader As String
        tmLeadersHash(convTantou2Leader(inputRow("SK"))) = 1
    Next
    
    extractTmleaders = tmLeadersHash.Keys
End Function

Function CalcJuchuuPlans(ByVal inputRows As Collection, _
                         ByVal startDate As Date, ByVal endDate As Date) As Object
    Dim summary As Object
    Set summary = CreateObject("Scripting.Dictionary") ' vbaのhash map
    
    Dim i As Integer
    For i = 1 To inputRows.Count
        Dim inputRow As Object
        Set inputRow = inputRows(i)
        
        Dim inDateStr As String
        inDateStr = inputRow("受注年月")
        
        ' 「20～」と入力されていれば、日付として扱う
        If Len(inDateStr) > 4 And Left(inDateStr, 2) = "20" Then
            
            Dim inDate As Date
            inDate = inputRow("受注年月")
            
            '数値であることの判定後、日付判定
            If inDate <= endDate Then
                Dim tmLeader As String
                tmLeader = convTantou2Leader(inputRow("SK"))
                Dim yyyymm As String
                Dim state As String
                
                If startDate <= inDate And inputRow("確度") <> "D" Then
                    Dim kakudo As String
                    yyyymm = ConvDate2Str(inDate)
                    Set summary = AddPrice2Hash(summary, tmLeader, yyyymm, inputRow("千円"))
                
                '前期の確度:A～Cテーマは、未受注テーマとして当期の初月(例:4月)でカウント
                ElseIf inDate < startDate And _
                (inputRow("確度") = "A" Or inputRow("確度") = "B" Or inputRow("確度") = "C") Then
                    yyyymm = ConvDate2Str(startDate)
                    Set summary = AddPrice2Hash(summary, tmLeader, yyyymm, inputRow("千円"))
                End If
            
            End If
        End If
    Next
    
    Set CalcJuchuuPlans = summary
End Function

Function CalcJuchuuDones(ByVal inputRows As Collection, _
                         ByVal startDate As Date, ByVal endDate As Date) As Object
    Dim summary As Object
    Set summary = CreateObject("Scripting.Dictionary")
    
    Dim i As Integer
    For i = 1 To inputRows.Count
        Dim inputRow As Object
        Set inputRow = inputRows(i)
        
        Dim inDateStr As String
        inDateStr = inputRow("受注年月")
        
        If Len(inDateStr) > 4 And Left(inDateStr, 2) = "20" And _
           (inputRow("確度") = "受" Or inputRow("確度") = "売") Then
            Dim inDate As Date
            inDate = inDateStr
            
            Dim tmLeader As String
            tmLeader = convTantou2Leader(inputRow("SK"))
            Dim yyyymm As String
            yyyymm = ConvDate2Str(inDate)
            Set summary = AddPrice2Hash(summary, tmLeader, yyyymm, inputRow("千円"))
        End If
    Next
    
    Set CalcJuchuuDones = summary
End Function


Function AddPrice2Hash(ByVal summary As Object, _
                       ByVal tmLeader As String, ByVal yyyymm As String, _
                       ByVal newPrice As Integer) As Object
    Dim setKey As String
    setKey = tmLeader & " " & yyyymm
    Dim tmpPrice
    tmpPrice = 0
    If summary.Exists(setKey) Then
        tmpPrice = summary(setKey)
    End If
    
    If IsNumeric(newPrice) Then
        summary(setKey) = tmpPrice + newPrice
    End If
    Set AddPrice2Hash = summary
End Function


Function convTantou2Leader(ByVal tantouName As String) As String
    Dim re As Object
    Set re = CreateObject("VBScript.RegExp") ' 正規表現とキャプチャ
    re.Pattern = "^([^\(\)]+)"
    Dim mc As Object
    Set mc = re.Execute(tantouName)
    If mc.Count > 0 Then
        convTantou2Leader = mc(0)
    Else
        convTantou2Leader = ""
    End If
End Function


'日付型をYYYYMM形式の文字列に変換
Function ConvDate2Str(ByVal orgDate As Date) As String
    Dim dateStr As String
    dateStr = Year(orgDate)
    If month(orgDate) < 10 Then
        dateStr = dateStr & "0" & month(orgDate)
    Else
        dateStr = dateStr & month(orgDate)
    End If
    
    ConvDate2Str = dateStr
End Function


Function ParseInputSheet(ByVal InSheet As Worksheet) As Collection

    Dim atriKeys As Collection
    Set atriKeys = ParseInputThead(InSheet)

    Dim inputRows As Collection
    Set inputRows = ParseInputTbody(InSheet, atriKeys)
    Set ParseInputSheet = inputRows
End Function


Function ParseInputTbody(ByVal InSheet As Worksheet, ByVal atriKeys As Collection) As Collection
    Dim inputRows As Collection
    Set inputRows = New Collection

    Dim rowCo As Integer
    rowCo = 3

    ' テーマ名があるものをloop
    Do While InSheet.Cells(rowCo, 2).Value <> "" And rowCo < 500 'テーマ数の最大値も設定
        Dim inputRow As Object
        Set inputRow = CreateObject("Scripting.Dictionary")
        Dim colCo As Integer
        colCo = 1
        
        Do While colCo < 50 '属性(カラム)の最大数も設定
            If InSheet.Cells(rowCo, colCo).Value <> "" Then
            '全角→半角してhash mapに登録
                inputRow(atriKeys(colCo)) = StrConv(InSheet.Cells(rowCo, colCo).Value, vbNarrow)
            End If
            colCo = colCo + 1
        Loop
        
        ' IsNumeric()は数値であることの判定
        If inputRow.Exists("千円") And IsNumeric(inputRow("千円")) Then
            inputRows.Add inputRow
        Else
            MsgBox "テーマ名:" & inputRow("テーマ名") & " は、受注額が数値以外の入力のようです"
        End If
        rowCo = rowCo + 1
    Loop
    
    Set ParseInputTbody = inputRows
End Function


Function ParseInputThead(ByVal InSheet As Worksheet) As Collection
    Dim atriKeys As Collection    '可変長配列
    Set atriKeys = New Collection
    
    Dim rowCo As Integer
    Dim colCo As Integer
    rowCo = 2
    colCo = 1

    Do While InSheet.Cells(rowCo, colCo).Value <> "" And colCo < 50
        Dim atriKey As String
        atriKey = InSheet.Cells(rowCo, colCo).Value
        
        If IsDate(atriKey) Then '日付の形式チェック
            Dim tmpDate As Date
            tmpDate = atriKey
            atriKey = tmpDate
        End If
    
        atriKeys.Add atriKey
        colCo = colCo + 1
    Loop

    Set ParseInputThead = atriKeys
End Function


Function setSheetFormat(ByVal newSheet As Worksheet) As Integer
    With newSheet.PageSetup
        .LeftMargin = Application.InchesToPoints(0.31496062992126)
        .RightMargin = Application.InchesToPoints(0.31496062992126)
        .TopMargin = Application.InchesToPoints(0.551181102362205)
        .BottomMargin = Application.InchesToPoints(0.551181102362205)
        .HeaderMargin = Application.InchesToPoints(0.31496062992126)
        .FooterMargin = Application.InchesToPoints(0.31496062992126)
        .Orientation = xlLandscape
        .PaperSize = xlPaperA4
        .FitToPagesWide = 1
        .FitToPagesTall = 1
    End With
    setSheetFormat = 1
End Function

'セルの書式(罫線)の設定
Function setTblColFrameLine(ByVal newSheet As Worksheet, _
                            ByVal rowCo1 As Integer, ByVal rowCo2 As Integer, _
                            ByVal colCo As Integer) As Integer
                       
    With newSheet.Range(Cells(rowCo1, colCo), Cells(rowCo2, colCo))
        .Borders(xlEdgeLeft).LineStyle = xlContinuous
        .Borders(xlEdgeLeft).ColorIndex = 0
        .Borders(xlEdgeLeft).Weight = xlThin
        
        .Borders(xlEdgeRight).LineStyle = xlContinuous
        .Borders(xlEdgeRight).ColorIndex = 0
        .Borders(xlEdgeRight).Weight = xlThin
        
        .Borders(xlEdgeTop).LineStyle = xlContinuous
        .Borders(xlEdgeTop).ColorIndex = 0
        .Borders(xlEdgeTop).Weight = xlThin
        
        .Borders(xlEdgeBottom).LineStyle = xlContinuous
        .Borders(xlEdgeBottom).ColorIndex = 0
        .Borders(xlEdgeBottom).Weight = xlThin
        
        .Borders(xlInsideHorizontal).LineStyle = xlContinuous
        .Borders(xlInsideHorizontal).ColorIndex = 0
        .Borders(xlInsideHorizontal).Weight = xlThin
    End With
    
    setTblColFrameLine = rowCo2
End Function

'条件付き書式(データバー)の設定
Function setTblColDatabar(ByVal newSheet As Worksheet, _
                          ByVal rowCo1 As Integer, ByVal rowCo2 As Integer, _
                          ByVal colCo As Integer, _
                          ByVal maxVal As Long, _
                          ByVal barColor As Variant) As Integer
    
    newSheet.Range(Cells(rowCo1, colCo), Cells(rowCo2, colCo)).FormatConditions.AddDatabar
    
    With newSheet.Range(Cells(rowCo1, colCo), Cells(rowCo2, colCo)).FormatConditions(1)
        .MinPoint.Modify newtype:=xlConditionValueNumber, newvalue:=0
        .MaxPoint.Modify newtype:=xlConditionValueNumber, newvalue:=maxVal
    
        .barColor.ThemeColor = barColor
        .barColor.TintAndShade = 0.599993896298105
        
        .BarFillType = xlDataBarFillSolid
        .Direction = xlContext
        .NegativeBarFormat.ColorType = xlDataBarColor
        .BarBorder.Type = xlDataBarBorderNone
        .AxisPosition = xlDataBarAxisAutomatic
    End With
    
    setTblColDatabar = rowCo2
End Function

'ワークシートの存在確認
Function ExistWorksheet(ByVal name As String) As Boolean
    Dim ws As Worksheet
    For Each ws In Sheets
        If ws.name = name Then
            ExistWorksheet = True
            Exit Function
        End If
    Next
    ExistWorksheet = False
End Function