pgbigorokuのブログ

プログラムの再利用できそうなコードをアップ

EXCEL VBAクラス テキストのリスト機能(ADD,REMOVEの機能)<clsLstTxt>

'オブジェクト名は「clsLstTxt」にしてください。
'
'   クラス機能   :  テキストのリスト機能(ADD,REMOVEの機能)
'
'プロパティ
'   -
'関数
'
'URL https://pgbigoroku.hatenablog.com/entry/2022/08/18/001621
'2022/8/17


Option Explicit

'簡易テキストリスト
'
'作成中 2022/8/16

Dim plst As Collection

Private Sub Class_Initialize()
    Set plst = New Collection
End Sub

Public Function Add(ByVal pstrItem As String) As Boolean
    Dim intGetIndex As Integer
    intGetIndex = getIndex(pstrItem)
    If intGetIndex = 0 Then
         plst.Add pstrItem
        Add = True
    Else
        Add = False
    End If
End Function

Public Function getIndex(ByVal pstrItem As String) As Integer
    Dim intFor As Integer
    For intFor = 1 To plst.Count
        If plst.Item(intFor) = pstrItem Then
            getIndex = intFor
            Exit Function
        End If
    Next
    getIndex = 0
End Function

Public Function Exists(ByVal pstrItem As String) As Boolean
    Dim intGetIndex As Integer
    intGetIndex = getIndex(pstrItem)
    If intGetIndex = 0 Then
        Exists = False
    Else
        Exists = True
    End If
End Function

Public Function Item(ByVal pintindex As Integer) As String
    If pintindex < 0 Then
    ElseIf pintindex >= plst.Count Then
    Else
        Items = plst(pintindex)
    End If
End Function

Public Function Remove(ByVal pintindex As Integer) As Boolean
    If pintindex <= 0 Then
    ElseIf pintindex > plst.Count Then
    Else
        plst.Remove pintindex
    End If
End Function

Public Function RemoveValue(ByVal pstrString As String) As Boolean
    Dim intGetIndex As Integer
    intGetIndex = getIndex(pstrItem)
    If intGetIndex = 0 Then
        RemoveValue = False
    Else
        plst.Remove intGetIndex
    End If
End Function

Public Function RemoveAll()
    Do Until plst.Count = 0
        plst.Remove 1
    Loop
End Function

Property Get Count() As Integer
    Count = plst.Count
End Property

Public Sub AddFromClsLstTxt(ByRef plstTxt As clsLstTxt)
    Dim intFor As Integer
    For intFor = 1 To plstTxt.Count
        Call Add(plstTxt.Item(intFor))
    Next
End Sub

'
' リストにあるデータを分割文字を挟んで結合する。
'
Public Function 結合(ByVal pstr分割文字 As String) As String
    Dim strTemp As String
    Dim strRet  As String
    Dim intFor As Integer
    For intFor = 1 To plst.Count
        If strRet = "" Then
            strRet = plst.Item(intFor)
        Else
            strRet = strRet & pstr分割文字 & plst.Item(intFor)
        End If
    Next
    結合 = strRet
End Function