Excel VBA 自作関数 のバックアップソース(No.1)

• バックアップ一覧
• バックアップ を表示
• Excel VBA 自作関数 は削除されています。
  • 1 (2016-02-05 (金) 08:11:03)

[[Excel VBA(仮)]]
#contents
**自作関数 [#aa2107a2]
***位置指定のコンテンツをクリアする [#u43368f9]
-サブルーチン名:s_clearContentRange
-引数:消したいセルの開始列、開始行

#ref(Sub_clearContentRange.PNG)

 '--------------------------------------------------------------------
 ' クリアコンテンツ（最終行取得→指定のセルまでをクリア）
 '--------------------------------------------------------------------
 Sub s_clearContentRangeRow(iStartCol, iStartRow)
    Dim iLogRow As Integer
    
    'クリアしたい位置の最終行を知る(下から最終行取得）
     iLogRow = Sheet1.Cells(Rows.Count, iStartCol).End(xlUp).Row
    
    'データ最終行と消したくない行データ（タイトルなど、ここでは「ログ出力」）が一致した場合
    'つまり消すデータがない
    If (iLogRow = iStartRow) Then
        Exit Sub
    '開始位置までのデータの値のみクリアする
    Else
        iLogRow = iLogRow - (iStartRow + 1)
    End If
    Sheet1.Range(Cells(iStartRow + 1, iStartCol), Cells(iStartRow + 1 + iLogRow, iStartCol)).ClearContents
    
 End Sub

***ログ出力をする [#lf5597fa]
-サブルーチン名:s_setLog(strMsg)
-引数:出力したいメッセージ
 '--------------------------------------------------------------------
 ' ログを書く
 '--------------------------------------------------------------------
 cnsLogStartRow:ログ出力開始位置（行）
 
 Sub s_setLog(strMsg)
    Dim iLogRow As Integer
    
    'ログの位置を知る(下から最終行取得）
    iLogRow = Sheet1.Cells(Rows.Count, cnsLogStartCol).End(xlUp).Row
    iLogRow = iLogRow - cnsLogStartRow + 1
    Sheet1.Cells(cnsLogStartRow + iLogRow, cnsLogStartCol) = strMsg
 
 End Sub

***エラーハンドリング [#m4466968]
-実行時エラー
-サブルーチン名:systemErr
-引数:エラーNo, エラー詳細, エラーが起きたサブルーチン
    '--------------------------------------------------------------------
    ' 実行時エラー処理
    '--------------------------------------------------------------------
    ' 実行時エラー時のエラーメッセージ出力
    Public Function systemErr(ByVal errNumber As Integer, _
                              ByVal errDescription As String, _
                              ByVal errProcedure As String) As Integer
        Dim ERR_MSG_01  As String
        Dim strErrMessage As String 'エラーメッセージ
        Dim intRet As Integer
        Dim ERR_MSG_TITLE   As String
        ERR_MSG_TITLE = "実行時エラー"
        ERR_MSG_01 = "システムエラーが発生しました。"
    
        strErrMessage = ERR_MSG_01 & Chr(13) & Chr(10) & _
                        "エラー番号：" & str(errNumber) & Chr(13) & Chr(10) & _
                        "エラーメッセージ：" & errDescription & Chr(13) & Chr(10) & _
                        "エラー発生箇所：" & errProcedure
        Debug.Print strErrMessage
    
        systemErr = MsgBox(strErrMessage, vbCritical + vbOKOnly, ERR_MSG_TITLE)
    
    End Function

-呼び出し元
    On Error GoTo ErrHandler
    --省略（処理）--        
    ErrHandler:
        '実行時エラー
        intRet = systemErr(Err.Number, Err.Description, "f_getFileName")
        '異常終了
        f_getFileName = True
        GoTo ExitHandler

**日付操作 [#z41d9bdd]
Sub test()
    Dim stryymmdd As String
    Dim dDate   As Date
    
    stryymmdd = "100210"
    
    dDate = CDate(Format(stryymmdd, "@@@@/@@/@@"))
    MsgBox Format(dDate, "yyyymmdd")
End Sub