VBA用の自作関数

本ページはプロモーションが含まれています

他の言語にあるやつとか個人的に使用頻度が高いのを書き溜め中

numExtract:文字列の中から数字だけを取り出す関数

半角数値しか取得しないので全角数値は対象外

Sub Sample()
Dim str As String
str = numExtract("h01o234599999678ge9") '--- 0123456789
End Sub
Public Function numExtract(StringValue As String) As String
Dim i As Long
Dim numText As String

For i = 1 To Len(StringValue)
    'Midで文字列を左から順に1文字ずつ照合する
     numText = Mid(StringValue, i, 1)
    'もしnumText[0-9]に該当する場合 変数numExtractに格納していく
     If numText Like "[0-9]" Then: numExtract = numExtract & numText
Next
End Function

StrPad:パディングする関数

代表的なのは前方を「0」埋めするゼロパディングだけど個人的には空白で固定長にする方が使うので規定値は後方に半角スペースを追加することにしてる

Sub Sample()
Dim str As String
str = StrPad("hoge", 10, "+", 0) '--- hoge++++++
str = StrPad(1, 5, 0, 1) '--- 00001
End Sub
Public Function StrPad(Target As String, Length As Long, Optional Pad_Str As String = " ", Optional Pad_Type As Long = 0) As String
'Target   --- ベースの文字
'Length   --- 桁数
'Pad_Str  --- 結合する文字 ※規定値:半角スペース
'Pad_Type --- 後方に付けるか前方に付けるか ※規定値:後方追加
Do While Len(Target) < Length
    Select Case Pad_Type
        Case 0 '---後方に追加する
            Target = Target & Pad_Str
        Case 1 '---前方に追加する
            Target = Pad_Str & Target
        Case Else '---例外なら後方に追加する
            Target = Target & Pad_Str
    End Select
Loop
StrPad = Target
End Function

RandBetween:乱数を指定範囲の値で取得する関数

指定の範囲内の乱数を返す
※実はWorksheetFunctionにある

Sub Sample()
Dim lng As Long
lng = RandBetween(20, 100)
lng = Application.WorksheetFunction.RandBetween(20, 100)
End Sub
Private Function RandBetween(min As Long, max As Long) As Long
Randomize
RandBetween = Int((max - min + 1) * Rnd + min)
End Function

RandTarget:指定の数値の中からランダムな値を返す関数

RandBetweenと違って範囲じゃなくて特定の値の中からランダムに選ぶ

Sub Sample()
Dim lng As Long
lng = RandTarget(33, 34, 35, 36, 37, 38, 40, 41, 42, 43, 44, 45, 46, 47, 58, 59, 60, 61, 62, 63, 64, 91, 92, 93, 94, 95, 96, 123, 124, 125, 126)
End Sub
Public Function RandTarget(ParamArray arr() As Variant) As Long
Dim lngRndMin As Long, lngRndMax As Long, lngRnd As Long
Dim objDic As Scripting.Dictionary
Dim v As Variant
Set objDic = CreateObject("Scripting.Dictionary")
'---一度対象の値を全てDictionaryに入れる
For Each v In arr
    If IsNumeric(v) And objDic.Exists(CLng(v)) = False Then
        objDic.Add CLng(v), CLng(v)
    End If
Next
'---最小値と最大値を取得
lngRndMin = Application.WorksheetFunction.Min(objDic.Keys)
lngRndMax = Application.WorksheetFunction.Max(objDic.Keys)
Do
    '---最小値と最大値の中からランダムな値を取得
    lngRnd = Application.WorksheetFunction.RandBetween(lngRndMin, lngRndMax)
    '---Dictionaryと突合して一致したら値を返してループを抜ける
    If objDic.Exists(lngRnd) Then
        RandTarget = lngRnd
        Exit Do
    End If
Loop
Set objDic = Nothing
End Function

InArray:検索値が配列の中に含まれているか確認する関数

PHPやjQueryにあるやつ
VBAの場合はDictionaryのExistsの方が正解な気もするけど

Sub Sample()
Dim bool As Boolean
bool = InArray("hoge", Array("hoge", "piyo", "test", "temp")) '---True
End Sub
Public Function InArray(Target As String, arr() As Variant) As Boolean
Dim v As Variant
For Each v In arr
    If Target = v Then
        InArray = True
        Exit For
    End If
Next
End Function

コメント

タイトルとURLをコピーしました