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

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

---

Excel VBA(仮)?

自作関数 †

位置指定のコンテンツをクリアする †

• サブルーチン名:s_clearContentRange
• 引数:消したいセルの開始列、開始行

#ref(): File not found: "Sub_clearContentRange.PNG" at page "Excel VBA 自作関数"

'--------------------------------------------------------------------
' クリアコンテンツ（最終行取得→指定のセルまでをクリア）
'--------------------------------------------------------------------
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

ログ出力をする †

• サブルーチン名: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

エラーハンドリング †

• 実行時エラー
• サブルーチン名: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

日付操作 †

Sub test()

   Dim stryymmdd As String
   Dim dDate   As Date
   
   stryymmdd = "100210"
   
   dDate = CDate(Format(stryymmdd, "@@@@/@@/@@"))
   MsgBox Format(dDate, "yyyymmdd")

End Sub