2015年2月26日木曜日

[Excel VBA] Rangeオブジェクトの2次元配列の作成

指定のセル範囲の各Rangeオブジェクトを2次元配列に格納
Public Function CreateRangeArray( _
        TargetRange As Range, _
        RangeArray() As Range, _
        Optional BaseIndex As Long = 0 _
    )

    If Not TypeOf TargetRange Is Range Then
        CreateRangeArray = 1
        Exit Function
    End If

    If BaseIndex < 0 Then
        CreateRangeArray = 2
        Exit Function
    End If

    Dim RowList As Object, ColList As Object
    Set RowList = CreateObject("System.Collections.SortedList")
    Set ColList = CreateObject("System.Collections.SortedList")

    Dim Cell As Range
    For Each Cell In TargetRange.Cells
        If Not RowList.ContainsKey(Cell.Row) Then
            Call RowList.Add(Cell.Row, 0)
        End If
        If Not ColList.ContainsKey(Cell.Column) Then
            Call ColList.Add(Cell.Column, 0)
        End If
    Next

    ReDim RangeArray( _
            0 + BaseIndex To RowList.Count - 1 + BaseIndex, _
            0 + BaseIndex To ColList.Count - 1 + BaseIndex _
        ) As Range

    Dim r As Long, c As Long
    For Each Cell In TargetRange.Cells
        r = RowList.IndexOfKey(Cell.Row)
        c = ColList.IndexOfKey(Cell.Column)
        Set RangeArray(r + BaseIndex, c + BaseIndex) = Cell
    Next

    CreateRangeArray = 0

End Function

[VBA] タブを空白に変換する関数

文字列内に含まれるタブを空白に変換する(ファンクション版)
Public Function TabToSpace(TabString As String, Optional TabSize As Long = 4) As String

    Dim CurrPos As Long, PrevPos As Long, FindPos As Long
    Dim SpcSize As Long, SubStr As String, Result As String

    CurrPos = 0
    PrevPos = 0
    FindPos = InStr(PrevPos + 1, TabString, vbTab)

    Do While FindPos > 0
        SubStr = Mid(TabString, PrevPos + 1, FindPos - PrevPos - 1)
        Result = Result & SubStr
        CurrPos = CurrPos + LenB(StrConv(SubStr, vbFromUnicode))
        
        SpcSize = TabSize - (CurrPos Mod TabSize)
        Result = Result & Space(SpcSize)
        CurrPos = CurrPos + SpcSize
        
        PrevPos = FindPos
        FindPos = InStr(PrevPos + 1, TabString, vbTab)
    Loop

    If PrevPos = 0 Then
        TabToSpace = TabString
    Else
        TabToSpace = Result & Mid(TabString, PrevPos + 1)
    End If

End Function


文字列内に含まれるタブを空白に変換する(プロシージャ版)
Public Sub Tab2Space(TabString As String, Optional TabSize As Long = 4)

    Dim CurrPos As Long, PrevPos As Long, FindPos As Long
    Dim SpcSize As Long, SubStr As String, Result As String

    CurrPos = 0
    PrevPos = 0
    FindPos = InStr(PrevPos + 1, TabString, vbTab)

    Do While FindPos > 0
        SubStr = Mid(TabString, PrevPos + 1, FindPos - PrevPos - 1)
        Result = Result & SubStr
        CurrPos = CurrPos + LenB(StrConv(SubStr, vbFromUnicode))
        
        SpcSize = TabSize - (CurrPos Mod TabSize)
        Result = Result & Space(SpcSize)
        CurrPos = CurrPos + SpcSize
        
        PrevPos = FindPos
        FindPos = InStr(PrevPos + 1, TabString, vbTab)
    Loop

    If PrevPos <> 0 Then
        TabString = Result & Mid(TabString, PrevPos + 1)
    End If

End Sub

[Excel VBA] 選択範囲の正規化(?)

複数のセル範囲を正規化します。
Public Function NormalizeRange(Ranges As Range) As Range

    Dim Retval As Range
    Dim i As Long

    If Not Ranges Is Nothing Then
        Set Retval = Ranges.Areas(1)
        For i = 2 To Ranges.Areas.Count Step 1
            Set Retval = Application.Union(Retval, Ranges.Areas(i))
        Next
    End If

    Set NormalizeRange = Retval

End Function

2014年11月29日土曜日

[JS] HTMLタグのエスケープ処理をおこなうツール

2014年10月2日木曜日

[Excel VBA] 正規表現パターンと一致する文字列を置換処理するワークシート関数






Public Function RegexReplace( _
        Source As String, _
        Pattern As String, _
        Replacement As String, _
        Optional Flags As String = "" _
    )

    With New VBScript_RegExp_55.RegExp
        If Flags = "" Then
            .Global = False
            .IgnoreCase = False
            .MultiLine = False
        Else
            .Global = Flags Like "*g*"
            .IgnoreCase = Flags Like "*i*"
            .MultiLine = Flags Like "*m*"
        End If
        .Pattern = Pattern
        RegexReplace = .Replace(Source, Replacement)
    End With

End Function





[Excel VBA] 正規表現パターンと一致する文字列(or 部分文字列)を取得、またはカウントするワークシート関数




※参照設定が必要
Microsoft VBScript Regular Expressions 5.5


Public Function Regex( _
        Source As String, _
        Pattern As String, _
        Optional Flags As String = "", _
        Optional MatchIndex As Long = 0, _
        Optional SubMatchIndex As Long = 0 _
    )

    Dim RetVal
    Dim Matches As VBScript_RegExp_55.MatchCollection
    Dim SubMatches As VBScript_RegExp_55.SubMatches

    If MatchIndex = 0 Then
        If SubMatchIndex = 0 Then
            With New VBScript_RegExp_55.RegExp
                If Flags = "" Then
                    .IgnoreCase = False
                    .MultiLine = False
                Else
                    .IgnoreCase = Flags Like "*i*"
                    .MultiLine = Flags Like "*m*"
                End If
                .Global = True
                .Pattern = Pattern
                RetVal = .Execute(Source).Count
            End With
        Else
            RetVal = CVErr(XlCVError.xlErrValue)
        End If

    ElseIf MatchIndex > 0 Then
        If SubMatchIndex = 0 Then

            With New VBScript_RegExp_55.RegExp
                If Flags = "" Then
                    .IgnoreCase = False
                    .MultiLine = False
                Else
                    .IgnoreCase = Flags Like "*i*"
                    .MultiLine = Flags Like "*m*"
                End If
                .Global = MatchIndex > 1
                .Pattern = Pattern
                Set Matches = .Execute(Source)
                If MatchIndex <= Matches.Count Then
                    RetVal = Matches(MatchIndex - 1).Value
                Else
                    RetVal = ""
                End If
            End With

        ElseIf SubMatchIndex > 0 Then

            With New VBScript_RegExp_55.RegExp
                If Flags = "" Then
                    .IgnoreCase = False
                    .MultiLine = False
                Else
                    .IgnoreCase = Flags Like "*i*"
                    .MultiLine = Flags Like "*m*"
                End If
                .Global = MatchIndex > 1
                .Pattern = Pattern
                Set Matches = .Execute(Source)
                If MatchIndex <= Matches.Count Then
                    Set SubMatches = Matches(MatchIndex - 1).SubMatches
                    If SubMatchIndex <= SubMatches.Count Then
                        RetVal = CStr(SubMatches(SubMatchIndex - 1))
                    Else
                        RetVal = ""
                    End If
                Else
                    RetVal = ""
                End If
            End With

        Else
            RetVal = CVErr(XlCVError.xlErrValue)
        End If
    Else
        RetVal = CVErr(XlCVError.xlErrValue)
    End If

    Regex = RetVal

End Function
















2014年8月17日日曜日

JavaScriptでクラス風の書き方

JavaScriptにて、Javaでいうところのクラスを書きたいときの方法。

1. publicで非staticなメソッドの実装

これには次の2通りの実装方法がある。

1. prototypeプロパティにfunctionを追加する
2. thisにfunctionを追加する

基本は 1 の実装方法をとるが、場合によっては 2 の方法をとる。

2. publicでstaticなメソッドの実装




3. privateで非staticなメソッドの実装



4. privateでstaticなメソッドの実装




基本形


var classFunc = (function(){

    var fn = function(){

        // パブリック・フィールド
        this.public_field1 = 0;

        // パブリック・メソッド1
        this.public_method1 = function(){

        }
    }

    // パブリック・メソッド2
    fn.prototype.public_method2 = function(){
        
    }

    // 静的パブリック・メソッド
    fn.public_static_method = function(){
       
    }

    // 静的パブリック・フィールド
    fn.public_static_field = 1;

    // プライベート・メソッド(呼び出し方により静的か否かが変わる)
    var private_method = function(){
        
    }

    // プライベート・フィールド
    var private_field = 10;

    return fn;

})();