プログラミングのメモ

プログラミングの学び直し備忘録

VBA：Excel ：検索（重複/重複でない セルをRangeで取得）

UserFormでlistBoxにシート名を表示
選択したシートに処理

【MAIN】

Private Sub mth_Main()

    '============================
    '// WorkSheet
    '============================
    Dim ListNo As Long
    ListNo = Me.lst_Sht.ListIndex
    If ListNo < 0 Then
        MsgBox "いずれかの行を選択してください"
        Exit Sub
    End If
    
    Dim ws As Worksheet
    Set ws = Workbooks(txt_FileOpen_RO.Text).Worksheets(Me.lst_Sht.List(ListNo))
    
    '----------------------
    '// 全Trim
    '----------------------
    Dim v
    For Each v In ws.UsedRange
        v.Value = Trim(v.Value)
    Next
    
    '========================================
    '// 重複/重複でない Range取得
    '========================================
    ws.Cells.Interior.Color = RGB(255, 255, 255)
    Dim iCols() As Long
    ReDim iCols(2)
    iCols(0) = 4
    iCols(1) = 6
    iCols(2) = 8
    
    Dim iRow_Last As Long
    iRow_Last = ws.Cells(ws.Rows.Count, iCols(0)).End(xlUp).Row
    
    Dim iRow_Start As Long
    iRow_Start = 2
    
    Dim rngDuplicateOrNat As Range
'    Set rngDuplicateOrNat = mth_GetDuplicateOrNotRng(ws, iRow_Start, iRow_Last, iCols, False)   '// 重複でない
    Set rngDuplicateOrNat = mth_GetDuplicateOrNotRng(ws, iRow_Start, iRow_Last, iCols, True)     '// 重複
        
    If Not rngDuplicateOrNat Is Nothing Then
        rngDuplicateOrNat.Interior.Color = RGB(192, 192, 0)
    End If
    
    Set rngDuplicateOrNat = Nothing
    Set ws = Nothing
    
End Sub

【処理MAIN】

'**
'* 重複/重複でない セルをRangeで取得
'* 指定範囲（指定行(開始/終了)、指定列(複数)）の重複/重複でない セルをRangeで取得
'*
'* @param   ws {Worksheet}      WorkSheet
'* @param   lRow_Start {Long}   開始行
'* @param   lRow_End {Long}     終了行
'* @param   iCols {Long()}      対象列リスト
'* @param   bDuplicate {bool}   True:重複検索 / False:重複でない検索
'* @return  {Range}             検出Range
'*
Public Function mth_GetDuplicateOrNotRng( _
                                        ws As Worksheet, _
                                        lRow_Start As Long, _
                                        lRow_End As Long, _
                                        iCols() As Long, _
                                        bDuplicate As Boolean _
                                        ) As Range
        
    Dim rngDupOrNot As Range   '// 重複/重複でない Range
    
    '// 汎用変数
    Dim r As Long, c As Long
    Dim v
    
    '=========================================================
    '// 行ごとに各列を結合して、検索対象リスト配列を作成
    '=========================================================
    Dim sCheckList_Rows() As String
    Dim lCheckList_Cnt As Long
    For r = lRow_Start To lRow_End
    
        Dim sCheckList As String
        sCheckList = ""
        For c = LBound(iCols) To UBound(iCols)
            sCheckList = sCheckList & ws.Cells(r, iCols(c))
        Next c
        
        ReDim Preserve sCheckList_Rows(lCheckList_Cnt)
        sCheckList_Rows(lCheckList_Cnt) = sCheckList
        lCheckList_Cnt = lCheckList_Cnt + 1
    Next r
                                    
    '=========================================================
    '// 行ごとに検索
    '=========================================================
    Dim lDupOrNot_Rows()   As Long     '重複/重複でない 行番号リスト
    Dim lDupOrNot_Cnt      As Long     '重複/重複でない 数
    
    lDupOrNot_Cnt = 0
    For r = lRow_Start To lRow_End
        
        '// 検索用に文字列結合
        Dim sCheckString As String
        sCheckString = ""
        For c = LBound(iCols) To UBound(iCols)
            sCheckString = sCheckString & ws.Cells(r, iCols(c))
        Next c
                
        '// 完全一致を検索
        Dim cltFind_Idx As Collection
        Set cltFind_Idx = mth_GetStrComp(sCheckList_Rows, sCheckString, True)
        
        '// 検索結果(重複/重複でない)
        If (bDuplicate = True And cltFind_Idx.Count > 1) _
        Or (bDuplicate = False And cltFind_Idx.Count = 1) _
        Then
            '// 検索条件（重複)      ：cltFind_Idx 2つ以上
            '// 検索条件（重複でない)：cltFind_Idx 1つ
            ReDim Preserve lDupOrNot_Rows(lDupOrNot_Cnt)
            lDupOrNot_Rows(lDupOrNot_Cnt) = r
            lDupOrNot_Cnt = lDupOrNot_Cnt + 1
        Else
            ' 検索条件外
        End If
    Next r
    
    '// 該当（重複/重複でない)がなければ終了
    If lDupOrNot_Cnt = 0 Then GoTo END_PROC
    
    '// Range設定
    lDupOrNot_Cnt = 0
    For Each v In lDupOrNot_Rows
        For c = LBound(iCols) To UBound(iCols)
            If lDupOrNot_Cnt = 0 And c = 0 Then
                Set rngDupOrNot = ws.Cells(v, iCols(c))
            Else
                Set rngDupOrNot = Union(rngDupOrNot, ws.Cells(v, iCols(c)))
            End If
        Next c
        
        lDupOrNot_Cnt = lDupOrNot_Cnt + 1
    Next v
    
END_PROC:
    Set mth_GetDuplicateOrNotRng = rngDupOrNot

End Function

【比較処理(StrComp)】

'**
'* 文字列配列から指定文字列のINDEXを取得する
'*
'* @param   sCheckLists {String()}  検索対象配列
'* @param   sCheckString {String}   検索文字列
'* @param   bSame {bool}            True:完全一致 / False:相違
'* @return  {Collection}            検出Index
'*
Public Function mth_GetStrComp( _
                                sCheckLists() As String, _
                                sCheckString As String, _
                                bCompMode_Same As Boolean _
                                ) As Collection
        
    Dim i As Long
    
    Dim cltFind_Idx As Collection
    Set cltFind_Idx = New Collection

    Dim lFind_Cnt As Long
    
    For i = LBound(sCheckLists) To UBound(sCheckLists)
        Dim lCompRes As Long
        lCompRes = StrComp(sCheckLists(i), sCheckString)
        
        If (bCompMode_Same And lCompRes = 0) _
        Or (bCompMode_Same = False And lCompRes <> 0) _
        Then
             cltFind_Idx.Add i
             lFind_Cnt = lFind_Cnt + 1
        End If
            
    Next i

    Set mth_GetStrComp = cltFind_Idx
        
End Function

VBA：Excel ：検索（行番号）

指定文字列の行番号取得

『シート全体』指定文字列の行番号取得

'■■■■■■■■■■■■■■■■■■■■■■■■■
'// 『シート全体』指定文字列の行番号取得
'//
'■■■■■■■■■■■■■■■■■■■■■■■■■
Private Sub psub_シート全体_指定文字列の行番号アドレス検索()

    Dim ws As Worksheet
    Set ws = ThisWorkbook.Worksheets(1)
    
    Dim sShrStr As String
    sShrStr = "検索"
    
    Dim lRes() As Long
    lRes = mth_GetCellRowNo_Sheet( _
                                    ws, _
                                    sShrStr _
                                    )
    
    Set ws = Nothing

End Sub

'*************************************************************************
'機能   : シート全体、指定文字列のアドレス検索
'戻り値 : アドレス配列
'ARG1   : WorkSheet
'ARG2   : 検索文字列
'説明   :
'*************************************************************************
Public Function mth_GetCellRowNo_Sheet( _
                                        ws As Worksheet, _
                                        sSrhString _
                                        ) As Long()

    Dim lRes_RowNo() As Long
    Dim vRes_RowNoBuf()
    
    Dim v As Variant
    
    Dim rngFindCell As Range
    Dim rngFind_1st As Range
    Dim rngFind_List As Range
    
    '===========================
    '// シート全体検索
    '===========================
    'LookIn:=xlValues 値検索
    'LookAt:=xlWhole 完全一致
    'MatchCase:=true 大文字と小文字を区別する(True)
    'MatchByte:=True 半角と全角を区別する(True)
    'SearchFormat 書式を検索しない(False)
    Set rngFindCell = ws.Cells.Find( _
                                    what:=sSrhString, _
                                    LookIn:=xlValues, _
                                    LookAt:=xlWhole, _
                                    MatchCase:=True, _
                                    MatchByte:=True, _
                                    SearchFormat:=False _
                                    )
    
    If rngFindCell Is Nothing Then
        Exit Function
    Else
        Set rngFind_1st = rngFindCell
        Set rngFind_List = rngFindCell
    End If
    
    '--------------------------------------------
    '// 検索 → Rangeリスト追加
    '--------------------------------------------
    Do
        '// 以降の検索条件も同一で検索
        Set rngFindCell = ws.Cells.FindNext(rngFindCell)
        
        '// 処理
        If rngFindCell.Address = rngFind_1st.Address Then
            Exit Do '// 最初に見つかったものと同じなら終了
        Else
            'Find_Listに追加していく
            Set rngFind_List = Union(rngFind_List, rngFindCell)
        End If
    Loop
    
    '---------------
    '// Result
    '---------------
    Dim i As Long: i = 0
    For Each v In rngFind_List
        ReDim Preserve vRes_RowNoBuf(i)
        vRes_RowNoBuf(i) = v.Row
        i = i + 1
    Next
    
    '// 重複削除
    vRes_RowNoBuf = m_配列.mth_DelSameVal(vRes_RowNoBuf)
    
    '// Variant -> Long
    For i = LBound(vRes_RowNoBuf) To UBound(vRes_RowNoBuf)
        ReDim Preserve lRes_RowNo(i)
        lRes_RowNo(i) = vRes_RowNoBuf(i)
    Next
    
    mth_GetCellRowNo_Sheet = lRes_RowNo
    
    '---------------
    '// 後処理
    '---------------
    Set rngFindCell = Nothing
    Set rngFind_1st = Nothing
    Set rngFind_List = Nothing
    
End Function

『範囲指定(Range)』指定文字列の行番号取得

'■■■■■■■■■■■■■■■■■■■■■■■■■
'// 『範囲指定(Range)』指定文字列の行番号取得
'//
'■■■■■■■■■■■■■■■■■■■■■■■■■
Private Sub psub_範囲_指定文字列の行番号アドレス検索()

    Dim ws As Worksheet
    Set ws = ThisWorkbook.Worksheets(1)
    
    Dim rng As Range
    Set rng = ws.Range("B2:E23")
    
    Dim sShrStr As String
    sShrStr = "検索"
    
    Dim lRes() As Long
    lRes = mth_GetCellRowNo_Range( _
                                    rng, _
                                    sShrStr _
                                    )
    
    Set ws = Nothing

End Sub

'*************************************************************************
'機能   : 『範囲指定(Range)』指定文字列の行番号取得
'戻り値 : アドレス配列
'ARG1   : Range
'ARG2   : 検索文字列
'説明   :
'*************************************************************************
Public Function mth_GetCellRowNo_Range( _
                                        rng As Range, _
                                        sSrhString _
                                        ) As Long()

    Dim lRes_RowNo() As Long
    Dim vRes_RowNoBuf()
    
    Dim v As Variant
    
    Dim rngFindCell As Range
    Dim rngFind_1st As Range
    Dim rngFind_List As Range
    
    '===========================
    '// シート全体検索
    '===========================
    'LookIn:=xlValues 値検索
    'LookAt:=xlWhole 完全一致
    'MatchCase:=true 大文字と小文字を区別する(True)
    'MatchByte:=True 半角と全角を区別する(True)
    'SearchFormat 書式を検索しない(False)
    Set rngFindCell = rng.Find( _
                                    what:=sSrhString, _
                                    LookIn:=xlValues, _
                                    LookAt:=xlWhole, _
                                    MatchCase:=True, _
                                    MatchByte:=True, _
                                    SearchFormat:=False _
                                    )
    
    If rngFindCell Is Nothing Then
        Exit Function
    Else
        Set rngFind_1st = rngFindCell
        Set rngFind_List = rngFindCell
    End If
    
    '--------------------------------------------
    '// 検索 → Rangeリスト追加
    '--------------------------------------------
    Do
        '// 以降の検索条件も同一で検索
        Set rngFindCell = rng.FindNext(rngFindCell)
        
        '// 処理
        If rngFindCell.Address = rngFind_1st.Address Then
            Exit Do '// 最初に見つかったものと同じなら終了
        Else
            'Find_Listに追加していく
            Set rngFind_List = Union(rngFind_List, rngFindCell)
        End If
    Loop
    
    '---------------
    '// Result
    '---------------
    Dim i As Long: i = 0
    For Each v In rngFind_List
        ReDim Preserve vRes_RowNoBuf(i)
        vRes_RowNoBuf(i) = v.Row
        i = i + 1
    Next
    
    '// 重複削除
    vRes_RowNoBuf = m_配列.mth_DelSameVal(vRes_RowNoBuf)
    
    '// Variant -> Long
    For i = LBound(vRes_RowNoBuf) To UBound(vRes_RowNoBuf)
        ReDim Preserve lRes_RowNo(i)
        lRes_RowNo(i) = vRes_RowNoBuf(i)
    Next
    
    mth_GetCellRowNo_Range = lRes_RowNo
    
    '---------------
    '// 後処理
    '---------------
    Set rngFindCell = Nothing
    Set rngFind_1st = Nothing
    Set rngFind_List = Nothing
    
End Function

『指定行範囲』指定文字列の行番号取得

'■■■■■■■■■■■■■■■■■■■■■■■■■
'// 『指定行範囲』指定文字列の行番号取得
'//
'■■■■■■■■■■■■■■■■■■■■■■■■■
Private Sub psub_指定行範囲_指定文字列の行番号アドレス検索()

    Dim ws As Worksheet
    Set ws = ThisWorkbook.Worksheets(1)
    
    Dim rng As Range
    Set rng = ws.Rows("2:12")
    
    Dim sShrStr As String
    sShrStr = "検索"
    
    Dim lRes() As Long
    lRes = mth_GetCellRowNo_Range( _
                                    rng, _
                                    sShrStr _
                                    )
    
    Set ws = Nothing

End Sub

重複削除

'*************************************************************************
'機能   : 重複削除
'戻り値 : 配列
'ARG1   : 配列
'説明   : Dictionaryで配列要素をKey､Valを追加
'           Key重複できないのでErrで追加不可
'           Key(Val)値は、重複削除の値となる
'*************************************************************************
Public Function mth_DelSameVal(vArrSrc() As Variant) As Variant()
    
    Dim dic
    Dim i As Long
    
    Set dic = CreateObject("Scripting.Dictionary")

On Error Resume Next
    For i = 0 To UBound(vArrSrc)
        dic.Add vArrSrc(i), vArrSrc(i)
    Next
    
    mth_DelSameVal = dic.keys
    
    Set dic = Nothing

End Function

VBA：Excel ：検索（アドレス）

ExcelVBA

『シート全体』指定文字列のアドレス検索

参考

ðÉÄÍÜéZðõ·é(Find/FindNext/FindPrevious\bh) FExcel VBAb¦øeNjbNbExcel VBAðwÔÈçmoug

VBAでセルの検索を続けて行う（FindNext、FindPrevious） ｜ Excel作業をVBAで効率化

'■■■■■■■■■■■■■■■■■■■■■■■■■
'// 『シート全体』指定文字列のアドレス検索
'//
'■■■■■■■■■■■■■■■■■■■■■■■■■
Private Sub psub_シート全体_指定文字列のアドレス検索()

    Dim ws As Worksheet
    Set ws = ThisWorkbook.Worksheets(1)
    
    Dim sShrStr As String
    sShrStr = "検索"
    
    Dim sRes() As String
    sRes = mth_GetCellAddress_Sheet( _
                                    ws, _
                                    sShrStr _
                                    )
    
    Set ws = Nothing

End Sub

'*************************************************************************
'機能   : シート全体、指定文字列のアドレス検索
'戻り値 : アドレス配列
'ARG1   : WorkSheet
'ARG2   : 検索文字列
'説明   :
'*************************************************************************
Public Function mth_GetCellAddress_Sheet( _
                                            ws As Worksheet, _
                                            sSrhString _
                                            ) As String()

    Dim sRes_Address() As String
    
    Dim v As Variant
    
    Dim rngFindCell As Range
    Dim rngFind_1st As Range
    Dim rngFind_List As Range
    
    '===========================
    '// 検索
    '===========================
    'LookIn:=xlValues 値検索
    'LookAt:=xlWhole 完全一致
    'MatchCase:=true 大文字と小文字を区別する(True)
    'MatchByte:=True 半角と全角を区別する(True)
    'SearchFormat 書式を検索しない(False)
    Set rngFindCell = ws.Cells.Find( _
                                    what:=sSrhString, _
                                    LookIn:=xlValues, _
                                    LookAt:=xlWhole, _
                                    MatchCase:=True, _
                                    MatchByte:=True, _
                                    SearchFormat:=False _
                                    )
    
    If rngFindCell Is Nothing Then
        Exit Function
    Else
        Set rngFind_1st = rngFindCell
        Set rngFind_List = rngFindCell
    End If
    
    '--------------------------------------------
    '// 検索 → Rangeリスト追加
    '--------------------------------------------
    Do
        '// 以降の検索条件も同一で検索
        Set rngFindCell = ws.Cells.FindNext(rngFindCell)
        
　　'// 検索不一致時はループを抜ける
        If rNext Is Nothing Then
            Exit Do
        End If

        '// 処理
        If rngFindCell.Address = rngFind_1st.Address Then
            Exit Do '// 最初に見つかったものと同じなら終了
        Else
            'Find_Listに追加していく
            Set rngFind_List = Union(rngFind_List, rngFindCell)
        End If
    Loop
    
    '---------------
    '// Result
    '---------------
    Dim i As Long: i = 0
    For Each v In rngFind_List
        ReDim Preserve sRes_Address(i)
        sRes_Address(i) = v.Address
        i = i + 1
    Next
    
    
    mth_Getアドレス_シート全体 = sRes_Address
    
    '---------------
    '// 後処理
    '---------------
    Set rngFindCell = Nothing
    Set rngFind_1st = Nothing
    Set rngFind_List = Nothing
    
End Function

『指定範囲（Range）』指定文字列のアドレス検索

'■■■■■■■■■■■■■■■■■■■■■■■■■
'// 『指定範囲（Range）』指定文字列のアドレス検索
'//
'■■■■■■■■■■■■■■■■■■■■■■■■■
Private Sub psub_指定範囲_指定文字列のアドレス検索()

    Dim ws As Worksheet
    Set ws = ThisWorkbook.Worksheets(1)
    
    Dim rng As Range
    Set rng = ws.Range("B2:E23")
    
    Dim sShrStr As String
    sShrStr = "検索"
    
    Dim sRes() As String
    sRes = mth_GetCellAddress_Range( _
                                    rng, _
                                    sShrStr _
                                    )
    
    Set ws = Nothing

End Sub

'*************************************************************************
'機能   : 『指定範囲（Range）』指定文字列のアドレス検索
'戻り値 : アドレス配列
'ARG1   : Range
'ARG2   : 検索文字列
'説明   :
'*************************************************************************
Public Function mth_GetCellAddress_Range( _
                                            rng As Range, _
                                            sSrhString _
                                            ) As String()

    Dim sRes_Address() As String
    
    Dim v As Variant
    
    Dim rngFindCell As Range
    Dim rngFind_1st As Range
    Dim rngFind_List As Range
    
    '===========================
    '// 検索
    '===========================
    'what:=sSrhString
    'After:=
    '%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
    'LookIn:=xlValues 値検索
    'LookAt:=xlWhole 完全一致
    'SearchOrder:= 検索方向を指定する。
    '               列方向に検索する（xlByColumns）、
    '               行方向に検索する（xlByRows）
    'MatchCase:=true 大文字と小文字を区別する(True)
    'MatchByte:=True 半角と全角を区別する(True)
    '%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
    'SearchDirection:= 前方に検索(xlNext：既定値)、
    '                   後方に検索(xlPrevious)
    'SearchFormat 書式を検索しない(False)
    '
    Set rngFindCell = rng.Find( _
                                    what:=sSrhString, _
                                    LookIn:=xlValues, _
                                    LookAt:=xlWhole, _
                                    MatchCase:=True, _
                                    MatchByte:=True, _
                                    SearchFormat:=False _
                                    )
    
    If rngFindCell Is Nothing Then
        Exit Function
    Else
        Set rngFind_1st = rngFindCell
        Set rngFind_List = rngFindCell
    End If
    
    '--------------------------------------------
    '// 検索 → Rangeリスト追加
    '--------------------------------------------
    Do
        '// 以降の検索条件も同一で検索
        Set rngFindCell = rng.FindNext(rngFindCell)
        
　　'// 検索不一致時はループを抜ける
        If rNext Is Nothing Then
            Exit Do
        End If

        '// 処理
        If rngFindCell.Address = rngFind_1st.Address Then
            Exit Do '// 最初に見つかったものと同じなら終了
        Else
            'Find_Listに追加していく
            Set rngFind_List = Union(rngFind_List, rngFindCell)
        End If
    Loop
    
    '---------------
    '// Result
    '---------------
    Dim i As Long: i = 0
    For Each v In rngFind_List
        ReDim Preserve sRes_Address(i)
        sRes_Address(i) = v.Address
        i = i + 1
    Next
    
    
    mth_GetCellAddress_Range = sRes_Address
    
    '---------------
    '// 後処理
    '---------------
    Set rngFindCell = Nothing
    Set rngFind_1st = Nothing
    Set rngFind_List = Nothing
    
End Function

『指定行』指定文字列のアドレス検索

'■■■■■■■■■■■■■■■■■■■■■■■■■
'// 『指定行』指定文字列のアドレス検索
'//
'■■■■■■■■■■■■■■■■■■■■■■■■■
Private Sub psub_行指定_指定文字列のアドレス検索()
    
    '====================================
    '単一行:Rows(2)
    '連続行:Range("2:5")
    '離れた行:Range("2:3,5:8,12:12")
    '====================================

    Dim ws As Worksheet
    Set ws = ThisWorkbook.Worksheets(1)
    
    Dim rng As Range
    Set rng = ws.Range("10:16")
    
    Dim sShrStr As String
    sShrStr = "検索"
    
    Dim sRes() As String
    sRes = mth_GetCellAddress_Range( _
                                    rng, _
                                    sShrStr _
                                    )
    
    Set ws = Nothing

End Sub

『指定行(1行)』指定文字列のアドレス検索

'■■■■■■■■■■■■■■■■■■■■■■■■■
'// 『指定行(1行)』指定文字列のアドレス検索
'//
'■■■■■■■■■■■■■■■■■■■■■■■■■
Private Sub psub_1行指定_指定文字列のアドレス検索()
    
    '====================================
    '単一行:Rows(2)
    '連続行:Range("2:5")
    '離れた行:Range("2:3,5:8,12:12")
    '====================================

    Dim ws As Worksheet
    Set ws = ThisWorkbook.Worksheets(1)
    
    Dim rng As Range
    Set rng = ws.Rows(10)
    
    Dim sShrStr As String
    sShrStr = "検索"
    
    Dim sRes() As String
    sRes = mth_GetCellAddress_Range( _
                                    rng, _
                                    sShrStr _
                                    )
    Set ws = Nothing

End Sub

『指定列』指定文字列のアドレス検索

'■■■■■■■■■■■■■■■■■■■■■■■■■
'// 『指定列』指定文字列のアドレス検索
'//
'■■■■■■■■■■■■■■■■■■■■■■■■■
Private Sub psub_列指定_指定文字列のアドレス検索()
    
    '====================================
    '[Columns]
    ' 単一列:Columns("G")
    ' 単一列:Columns(2)
    ' 連続列:Columns("F:E")
    '-------------------------------------
    '[Range]
    ' 連続列:Range("E:F").EntireColumn
    ' 離れた列:Range("E:E,G:H")
    ' 離れた列:Range("E1,G1:H1").EntireColumn
    '====================================

    Dim ws As Worksheet
    Set ws = ThisWorkbook.Worksheets(1)
    
    Dim rng As Range
    Set rng = ws.Range("E:E,G:H")
    
    Dim sShrStr As String
    sShrStr = "検索"
    
    Dim sRes() As String
    sRes = mth_GetCellAddress_Range( _
                                    rng, _
                                    sShrStr _
                                    )
    
    Set ws = Nothing

End Sub

『指定列(1列)』指定文字列のアドレス検索

'■■■■■■■■■■■■■■■■■■■■■■■■■
'// 『指定列(1列)』指定文字列のアドレス検索
'//
'■■■■■■■■■■■■■■■■■■■■■■■■■
Private Sub psub_1列指定_指定文字列のアドレス検索()
    
    '====================================
    '[Columns]
    ' 単一列:Columns("G")
    ' 単一列:Columns(2)
    ' 連続列:Columns("F:E")
    '-------------------------------------
    '[Range]
    ' 連続列:Range("E:F").EntireColumn
    ' 離れた列:Range("E:E,G:H")
    ' 離れた列:Range("E1,G1:H1").EntireColumn
    '====================================

    Dim ws As Worksheet
    Set ws = ThisWorkbook.Worksheets(1)
    
    Dim rng As Range
    Set rng = ws.Columns("G")
    
    Dim sShrStr As String
    sShrStr = "検索"
    
    Dim sRes() As String
    sRes = mth_GetCellAddress_Range( _
                                    rng, _
                                    sShrStr _
                                    )
    
    Set ws = Nothing

End Sub

文字列を検索して、指定アドレスを返す。(Collection)

Enum enmAddress
    Address = 1
    Row = 2
    Col = 3
End Enum

Sub test()

    Dim ws As Worksheet
    Set ws = ThisWorkbook.Worksheets(2)
    
    Dim cRes As Collection
    Set cRes = New Collection
    Call mth_GetCellAddress_InSheet(ws, "検索", enmAddress.Address, cRes)
    
    Debug.Print cRes.Count
    
End Sub

'**
'* 文字列を検索して、指定アドレスを返す。
'*
'* @arg     {ws}
'* @arg     {str}
'* @arg     {enmAddress}
'* @arg_ref {colc}
'* @arg_opt {}
'* @ret     {}
'*
'* @note
'*
Public Sub mth_GetCellAddress_InSheet( _
                                    ws As Worksheet, _
                                    sSrhString As String, _
                                    enmAddress As enmAddress, _
                                    ByRef colcRef As Collection _
                                    )

    Dim rngFindCell As Range
    Dim rngFind_1st As Range
    Dim rngFind_List As Range
    
    '===========================
    '// シート全体検索
    '===========================
    'LookIn:=xlValues 値検索
    'LookAt:=xlWhole 完全一致
    'MatchCase:=true 大文字と小文字を区別する(True)
    'MatchByte:=True 半角と全角を区別する(True)
    'SearchFormat 書式を検索しない(False)
    Set rngFindCell = ws.Cells.Find( _
                                    what:=sSrhString, _
                                    LookIn:=xlValues, _
                                    LookAt:=xlWhole, _
                                    MatchCase:=True, _
                                    MatchByte:=True, _
                                    SearchFormat:=False _
                                    )
    
    If rngFindCell Is Nothing Then
        Exit Sub
    Else
        Set rngFind_1st = rngFindCell
        Set rngFind_List = rngFindCell
    End If
    
    '--------------------------------------------
    '// 検索 → Rangeリスト追加
    '--------------------------------------------
    Do
        '// 以降の検索条件も同一で検索
        Set rngFindCell = ws.Cells.FindNext(rngFindCell)
        
        '// 処理
        If rngFindCell.Address = rngFind_1st.Address Then
            Exit Do '// 最初に見つかったものと同じなら終了
        Else
            'Find_Listに追加していく
            Set rngFind_List = Union(rngFind_List, rngFindCell)
        End If
    Loop
    
    '---------------
    '// Result
    '---------------
    Dim v
    For Each v In rngFind_List
        Select Case enmAddress
            Case Address: colcRef.Add (v.Address)
            Case Row:    colcRef.Add (v.Row)
            Case Col:    colcRef.Add (v.Column)
        End Select
    Next
    
    '// 重複削除
    Dim colcRes As Collection
    Set colcRes = New Collection
    Call mth_DelSameVal_colec(colcRes)
    
    '---------------
    '// 後処理
    '---------------
    Set rngFindCell = Nothing
    Set rngFind_1st = Nothing
    Set rngFind_List = Nothing
    
End Sub

'**
'* 重複削除
'*
'* @arg     {}
'* @arg_ref {colc}
'* @arg_opt {}
'* @ret     {}
'*
'* @note
'*  Dictionaryで配列要素をKey､Valを追加
'*  Key重複できないのでErrで追加不可
'*  Key(Val)値は、重複削除の値となる
'*
Public Sub mth_DelSameVal_colec(ByRef clctRefTg As Collection)
    
    Dim dic
    Dim i As Long
    
    Set dic = CreateObject("Scripting.Dictionary")

On Error Resume Next
    For i = 1 To clctRefTg.Count
        dic.Add clctRefTg.Item(i), clctRefTg.Item(i)
    Next
    
    '// コレクションクリア
    For i = 1 To clctRefTg.Count
        clctRefTg.Remove 1
    Next
    
    '// コレクション 再設定
    Dim vFE_Key
    For Each vFE_Key In dic
        clctRefTg.Add (vFE_Key)
    Next vFE_Key
            
    Set dic = Nothing

End Sub

VBA：Excel ：配列

ExcelVBA

【 Tips 】

文字列配列から指定文字列のINDEXを取得する

'**
'* 文字列配列から指定文字列のINDEXを取得する
'*
'* @param   sCheckLists {String()}  検索対象配列
'* @param   sCheckString {String}   検索文字列
'* @param   bSame {bool}            True:完全一致 / False:相違
'* @return  {Collection}            検出Index
'*
Public Function mth_GetStrComp( _
                                sCheckLists() As String, _
                                sCheckString As String, _
                                bCompMode_Same As Boolean _
                                ) As Collection
        
    Dim i As Long
    
    Dim cltFind_Idx As Collection
    Set cltFind_Idx = New Collection

    Dim lFind_Cnt As Long
    Dim lFind_Idx() As Long
    
    For i = LBound(sCheckLists) To UBound(sCheckLists)
        Dim lCompRes As Long
        lCompRes = StrComp(sCheckLists(i), sCheckString)
        
        If (bCompMode_Same And lCompRes = 0) _
        Or (bCompMode_Same = False And lCompRes <> 0) _
        Then
             ReDim Preserve lFind_Idx(lFind_Cnt)
             cltFind_Idx.Add i
             lFind_Idx(lFind_Cnt) = i
             lFind_Cnt = lFind_Cnt + 1
        End If
            
    Next i

    Set mth_GetStrComp = cltFind_Idx
        
End Function

特定の文字を含む（含まない） ：Filter

Filter(sourcearray, match, [ include, [ compare ]])

Sub test()
    
    Dim s(4) As String
    s(0) = "aaaa"
    s(1) = "aaaa"
    s(2) = "adaaa"
    s(3) = "aagaa"
    s(4) = "ccc"
    
    Dim res
    res = Filter(s, "aaaa", True)
    
    res = Filter(s, "aaaa", False)

    Debug.Print UBound(res)
End Sub

空かどうか確認

'■■■■■■■■■■■■■■■■■■■■■■■■■
'// 配列かどうか/空かどうか確認
'//
'■■■■■■■■■■■■■■■■■■■■■■■■■
Private Sub psub_配列かどうか_空かどうか確認()

    Dim lRes As Long
    
    Dim vArr() As Variant
    
    '// 空の配列:0
    lRes = mth_IsArrayEx(vArr)
    Debug.Print lRes
    
    '// 配列:1
    vArr = Array("a", 1)
    lRes = mth_IsArrayEx(vArr)
    Debug.Print lRes

End Sub

'*************************************************************************
'機能   : 引数が配列かどうか判断し、配列の場合は空かどうか判断する
'戻り値 : 1:配列 / 0:空の配列 / -1：配列でない
'ARG1   : 配列
'*************************************************************************
Public Function mth_IsArrayEx(vArr As Variant) As Long

On Error GoTo ERR_PROC
    
    If IsArray(vArr) Then   '// 配列確認
        mth_IsArrayEx = IIf(UBound(vArr) >= 0, 1, 0)
        ' 三項演算子:　UBound(vArr) >= 0 then 1 else 0
        ' 配列が空の場合、Err=9（インデックスが有効範囲にありません）
    Else
        mth_IsArrayEx = -1  '配列でない
    End If
    
    Exit Function
        
ERR_PROC:
    If Err.Number = 9 Then  '// UBound(vArr)
        mth_IsArrayEx = 0   '// vArr = Empty
    End If
    
End Function

重複削除

'■■■■■■■■■■■■■■■■■■■■■■■■■
'// 重複削除
'//
'■■■■■■■■■■■■■■■■■■■■■■■■■
Private Sub psub_重複削除()
    
    Dim arr()
    arr() = Array(1, 1, 1, 4, 8, 5, 4, 3)
    
    Dim vResArr()
    vResArr = mth_DelSameVal(arr())

End Sub


'*************************************************************************
'機能   : 重複削除
'戻り値 : 配列
'ARG1   : 配列
'説明   : Dictionaryで配列要素をKey､Valを追加
'           Key重複できないのでErrで追加不可
'           Key(Val)値は、重複削除の値となる
'*************************************************************************
Public Function mth_DelSameVal(vArrSrc() As Variant) As Variant
    
    Dim dic
    Dim i As Long
    
    Set dic = CreateObject("Scripting.Dictionary")

On Error Resume Next
    For i = 0 To UBound(vArrSrc)
        dic.Add vArrSrc(i), vArrSrc(i)
    Next
    
    mth_DelSameVal = dic.keys
    
    Set dic = Nothing

End Function

ソート：クイックソート

'■■■■■■■■■■■■■■■■■■■■■■■■■
'// Sort：クイックソート
'//
'■■■■■■■■■■■■■■■■■■■■■■■■■
Private Sub psub_Sort_クイック()
    
    Dim arr()
    arr() = Array(1, 51, 4, 8, 5, 45, 3, 8)
    
    Dim vResArr()
    vResArr = mth_SortQuick(arr(), LBound(arr), UBound(arr))

End Sub


'*************************************************************************
'機能   : Sort：クイック
'戻り値 : 配列
'ARG1   : 対象配列
'ARG2   : LBound(対象配列)
'ARG3   : UBound(対象配列)
'説明   :
'*************************************************************************
Public Function mth_SortQuick( _
                                ByRef vargArr() As Variant, _
                                ByVal lngMin As Long, _
                                ByVal lngMax As Long _
                                ) As Variant()
    Dim i As Long, j As Long
    Dim vBase As Variant
    Dim vSwap As Variant
    
    vBase = vargArr(Int((lngMin + lngMax) / 2))
    i = lngMin
    j = lngMax
    
    Do
        Do While vargArr(i) < vBase
            i = i + 1
        Loop
        
        Do While vargArr(j) > vBase
            j = j - 1
        Loop
        
        If i >= j Then Exit Do
        
        vSwap = vargArr(i)
        vargArr(i) = vargArr(j)
        vargArr(j) = vSwap
        i = i + 1
        j = j - 1
    Loop
    
    If (lngMin < i - 1) Then
        Call mth_SortQuick(vargArr, lngMin, i - 1)
    End If
        
    If (lngMax > j + 1) Then
        Call mth_SortQuick(vargArr, j + 1, lngMax)
    End If

    mth_SortQuick = vargArr
    
End Function

Match・Index

Private Sub btnOth__Click()

    '// 出力データ生成
    Dim vArr(2, 5) As Variant
    
    Dim r As Long, c As Long
    For r = LBound(vArr, 1) To UBound(vArr, 1)
        For c = LBound(vArr, 2) To UBound(vArr, 2)
            vArr(r, c) = CStr(r) & CStr(c)
        Next c
    Next r
    
    '// 出力
    Dim ws02 As Worksheet: Set ws02 = ThisWorkbook.Worksheets("WS02")
    Dim rngStartCell As Range
    Set rngStartCell = ws02.Range("B2")
    
    ws02.Cells.Clear
    Call mth_SetGetCellValArr(vArr, rngStartCell)
    
    Set rngStartCell = Nothing
    
'%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

'%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
'Range検索
    Dim rngSrc As Range
    Set rngSrc = ws02.Range("B2").CurrentRegion
    
    '// Srh Rec
    Dim vSrhRecVal  As Variant: vSrhRecVal = 10
    Dim lSrhRecNo   As Long
    lSrhRecNo = WorksheetFunction.Match(vSrhRecVal, rngSrc.Columns(1), 0)
    
    '// Srh Fld
    Dim vSrhFldVal  As Variant: vSrhFldVal = 4
    Dim lSrhFldNo As Long
    lSrhFldNo = WorksheetFunction.Match(vSrhFldVal, rngSrc.Rows(1), 0)
    
    
    '// ResVal
    Dim vGetVal As Variant
    '-- FLD --
    vGetVal = rngSrc.Columns(lSrhFldNo)                                 '(ex)Arr(1 To 3, 1 To 1)
    vGetVal = WorksheetFunction.Transpose(rngSrc.Columns(lSrhFldNo))    '(ex)Arr(3,1) -> Arr(1)
    
    '-- REC --
    vGetVal = rngSrc.Rows(lSrhRecNo)                    '(ex)Arr(1 To 1, 1 To 6)
    vGetVal = WorksheetFunction.Transpose(vGetVal)      '(ex)Arr(1,6) -> Arr(6,1)
    vGetVal = WorksheetFunction.Transpose(vGetVal)      '(ex)Arr(6,1) -> Arr(6)     'Recが1つしかないので1次元になる
    '↓ まとめると↓
    vGetVal = WorksheetFunction.Transpose(WorksheetFunction.Transpose(rngSrc.Rows(lSrhRecNo)))
    
    '-- TABLE --
    vGetVal = WorksheetFunction.Index(rngSrc, lSrhRecNo, lSrhFldNo)
    MsgBox vGetVal
    
'&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&
'配列検索
    
    '// ResVal
    vGetVal = WorksheetFunction.Index(WorksheetFunction.Transpose(vArr), lSrhFldNo)  '// Fld 1dArr
    vGetVal = WorksheetFunction.Index(vArr, lSrhRecNo)  '// Rec 1dArr
    vGetVal = WorksheetFunction.Index(vArr, lSrhRecNo, lSrhFldNo)
    MsgBox vGetVal

End Sub

Private Sub btnOth_検索_Click()
    '// 出力データ生成
    Dim vArr(3, 5) As Variant
    
    Dim r As Long, c As Long
    For r = LBound(vArr, 1) To UBound(vArr, 1)
        For c = LBound(vArr, 2) To UBound(vArr, 2)
            If r <> 3 Then
                vArr(r, c) = CStr(r) & CStr(c)
            Else
                vArr(r, c) = CStr(r - 2) & CStr(c)
            End If
        Next c
    Next r
    
    '// 出力
    Dim ws02 As Worksheet: Set ws02 = ThisWorkbook.Worksheets("WS02")
    Dim rngStartCell As Range
    Set rngStartCell = ws02.Range("B2")
    
    ws02.Cells.Clear
    Call mth_SetGetCellValArr(vArr, rngStartCell)
    
    Set rngStartCell = Nothing
    
'%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

'%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
    Dim rngSrhKey As Range
    Set rngSrhKey = ws02.Range("B2:B5")
    
    '// Srh Rec
    Dim vSrhKey
    vSrhKey = 10
    
    '// Get RecNos
    Dim lSrhRecNos() As Long
    lSrhRecNos = m_検索_アドレス.mth_GetRowNo_Rang(rngSrhKey, vSrhKey)
    
    '//　出力開始位置の行Noを「1」として、RecNoを算出
    Dim i As Long
    For i = LBound(lSrhRecNos) To UBound(lSrhRecNos)
        lSrhRecNos(i) = lSrhRecNos(i) - (ws02.Range("B2").Row - 1)
    Next i
    
    '// Srh Fld
    Dim rngSrc As Range
    Set rngSrc = ws02.Range("B2").CurrentRegion
    Dim vSrhFldVal  As Variant: vSrhFldVal = 4
    Dim lSrhFldNo As Long
    lSrhFldNo = WorksheetFunction.Match(vSrhFldVal, rngSrc.Rows(1), 0)
    

'%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

'%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
'Range検索

Dim lSrhRecNo
For Each lSrhRecNo In lSrhRecNos
    
    '// ResVal
    Dim vGetVal As Variant
    '-- FLD --
    vGetVal = rngSrc.Columns(lSrhFldNo)                                 '(ex)Arr(1 To 3, 1 To 1)
    vGetVal = WorksheetFunction.Transpose(rngSrc.Columns(lSrhFldNo))    '(ex)Arr(3,1) -> Arr(1)
    
    '-- REC --
    vGetVal = rngSrc.Rows(lSrhRecNo)                    '(ex)Arr(1 To 1, 1 To 6)
    vGetVal = WorksheetFunction.Transpose(vGetVal)      '(ex)Arr(1,6) -> Arr(6,1)
    vGetVal = WorksheetFunction.Transpose(vGetVal)      '(ex)Arr(6,1) -> Arr(6)     'Recが1つしかないので1次元になる
    '↓ まとめると↓
    vGetVal = WorksheetFunction.Transpose(WorksheetFunction.Transpose(rngSrc.Rows(lSrhRecNo)))
    
    '-- TABLE --
    vGetVal = WorksheetFunction.Index(rngSrc, lSrhRecNo, lSrhFldNo)
    MsgBox vGetVal
    
'&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&
'配列検索
    
    '// ResVal
    vGetVal = WorksheetFunction.Index(WorksheetFunction.Transpose(vArr), lSrhFldNo)  '// Fld 1dArr
    vGetVal = WorksheetFunction.Index(vArr, lSrhRecNo)  '// Rec 1dArr
    vGetVal = WorksheetFunction.Index(vArr, lSrhRecNo, lSrhFldNo)
    MsgBox vGetVal

Next lSrhRecNo

End Sub

Match・VLookup

Private Sub btnOth_VlookUp_Click()

    '// 出力データ生成
    Dim vArr(2, 5) As Variant
    
    Dim r As Long, c As Long
    For r = LBound(vArr, 1) To UBound(vArr, 1)
        For c = LBound(vArr, 2) To UBound(vArr, 2)
            vArr(r, c) = CStr(r) & CStr(c)
        Next c
    Next r
    
    '// 出力
    Dim ws02 As Worksheet: Set ws02 = ThisWorkbook.Worksheets("WS02")
    Dim rngStartCell As Range
    Set rngStartCell = ws02.Range("B2")
    
    ws02.Cells.Clear
    Call mth_SetGetCellValArr(vArr, rngStartCell)
    
    Set rngStartCell = Nothing
    
'%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

'%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
'Range検索
    Dim rngSrc As Range
    Set rngSrc = ws02.Range("B2").CurrentRegion
    
    '// Srh Rec
    Dim vSrhRecVal  As Variant: vSrhRecVal = 20
    Dim lSrhRecNo   As Long
    lSrhRecNo = WorksheetFunction.Match(vSrhRecVal, rngSrc.Columns(1), 0)
    
    '// Srh Fld
    Dim vSrhFldVal  As Variant: vSrhFldVal = 3
    Dim lSrhFldNo As Long
    lSrhFldNo = WorksheetFunction.Match(vSrhFldVal, rngSrc.Rows(1), 0)
    
    
    '// ResVal
    Dim vGetVal As Variant
    vGetVal = WorksheetFunction.VLookup(vSrhRecVal, rngSrc, lSrhFldNo, False)
    MsgBox vGetVal
    
'&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&
'配列検索
    
    '// ResVal
        '不可
End Sub

【配列とセル】

セル範囲の値を配列に格納

'■■■■■■■■■■■■■■■■■■■■■■■■■
'// セル範囲の値を配列に格納
'//
'■■■■■■■■■■■■■■■■■■■■■■■■■
Private Sub psub_セル範囲の値を配列に格納()

    Dim rngSrc As Range
    Set rngSrc = ThisWorkbook.Worksheets(1).Range("A1:D25")
    
    Dim vResArr() As Variant
    vResArr = mth_GetCellValArr(rngSrc)
    
    Set rngSrc = Nothing

End Sub

'*************************************************************************
'機能   : セル範囲の値取得
'戻り値 : 配列
'ARG1   : Range
'説明   :
'*************************************************************************
Public Function mth_GetCellValArr(rng As Range) As Variant()

    '=======================
    '// セルの値を要素に代入
    '=======================
    Dim vArrCell As Variant
    vArrCell = rng.Value    '※indexは「1」から
    
    mth_GetCellValArr = vArrCell
    
End Function

指定行（開始・終了行指定）、指定列のセル値を「配列の配列」で返す

'■■■■■■■■■■■■■■■■■■■■■■■■■■■■■
'// 指定行範囲（開始・終了行指定）、指定列のセル値を
'// 「配列の配列:Arr(Row)(Col)」で返す
'■■■■■■■■■■■■■■■■■■■■■■■■■■■■■
Private Sub psub_指定Row範囲_指定Colリストのセル値を配列の配列で返す()
    
    Dim ws As Worksheet
    Set ws = ThisWorkbook.Worksheets(1)
    
    '// 対象行範囲
    Dim lRowStartEnd(1) As Long
    lRowStartEnd(0) = 3: lRowStartEnd(1) = 8
    
    '// 抽出列
    Dim lColNos(3) As Long
    lColNos(0) = 2
    lColNos(1) = 3
    lColNos(2) = 5
    lColNos(3) = Columns("G").Column
    
    '// 配列の配列データ取得
    Dim vRes_ArrOfArr()
    vRes_ArrOfArr = mth_GetCellVal_ArrOfArr(ws, lRowStartEnd, lColNos)
    
End Sub


'*************************************************************************
'機能   : 指定行範囲、指定列番号リストのセル値を配列の配列で返す
'戻り値 : 配列の配列
'ARG1   : WorkSheet
'ARG2   : 行範囲配列(開始：終了)
'ARG3   : 対象列番号
'説明   :
'*************************************************************************
Public Function mth_GetCellVal_ArrOfArr( _
                                        ws As Worksheet, _
                                        lRowStartEnd() As Long, _
                                        lColNos() As Long _
                                        ) As Variant
    Dim vResDat() As Variant
    
    Dim lRow As Long
    
    Dim i As Long: i = 0
    For lRow = lRowStartEnd(LBound(lRowStartEnd)) To lRowStartEnd(UBound(lRowStartEnd))
        ReDim Preserve vResDat(i)
        
        '// 列データ
        Dim sBuf()
        ReDim sBuf(UBound(lColNos))
                
                        
        Dim j As Long: j = 0
        Dim vCol As Variant
        For Each vCol In lColNos
            sBuf(j) = ws.Cells(lRow, vCol).Value
            j = j + 1
        Next
        
        vResDat(i) = sBuf
        i = i + 1
    Next
    
    mth_GetCellVal_ArrOfArr = vResDat
        
End Function

配列の配列を２次元配列で返す

'■■■■■■■■■■■■■■■■■■■■■■■■■■■■■
'// 配列の配列を2次元配列で返す
'//
'■■■■■■■■■■■■■■■■■■■■■■■■■■■■■
Private Sub psub_配列の配列を2次元配列で返す()
    
    Dim ws As Worksheet
    Set ws = ThisWorkbook.Worksheets(1)
    
    '// 対象行範囲
    Dim lRowStartEnd(1) As Long
    lRowStartEnd(0) = 3: lRowStartEnd(1) = 8
    
    '// 抽出列
    Dim lColNos(3) As Long
    lColNos(0) = 2
    lColNos(1) = 3
    lColNos(2) = 5
    lColNos(3) = Columns("G").Column
    
    '// 配列の配列データ取得
    Dim vRes_ArrOfArr()
    vRes_ArrOfArr = mth_GetCellVal_ArrOfArr(ws, lRowStartEnd, lColNos)
    
    '// 配列の配列から2次元配列
    Dim vRes_Arr2d()
    vRes_Arr2d = mth_ArrayOfArray2Array(vRes_ArrOfArr)
    
    
End Sub


'*************************************************************************
'機能   : 配列の配列を2次元配列で返す
'戻り値 : 2次元配列
'ARG1   : 配列の配列
'説明   : 配列内の配列は、1次元。
'           先頭配列の要素数に合わせる
'*************************************************************************
Public Function mth_ArrayOfArray2Array( _
                                        vArrayOfArray As Variant _
                                        ) As Variant
        
    Dim r As Long, c As Long
    
    '//
    Dim vRes_2dArr()
    
    ReDim vRes_2dArr(UBound(vArrayOfArray), UBound(vArrayOfArray(0)))
    
    For r = LBound(vArrayOfArray) To UBound(vArrayOfArray)  '// 1段目配列（行）
        For c = LBound(vArrayOfArray(c)) To UBound(vArrayOfArray(c))    '// 2段目配列（列）
            vRes_2dArr(r, c) = vArrayOfArray(r)(c)
        Next
    Next
    
    mth_ArrayOfArray2Array = vRes_2dArr
    
End Function

配列1D　→　セルに出力

'■■■■■■■■■■■■■■■■■■■■■■■■■
'// 配列1Dをセルに出力
'//
'■■■■■■■■■■■■■■■■■■■■■■■■■
Public Sub psub_配列1Dをセルに出力()

    Dim ws As Worksheet: Set ws = ThisWorkbook.Worksheets("WS02")
    ws.Cells.ClearContents
    
    Dim vArr()
    vArr = Array(1, 3, 5, 4, 2)
    
    '// 出力
    Dim rngStartCell As Range
    Set rngStartCell = ws.Range("B2")
    
    Call mth_SetCell1DArr(vArr, rngStartCell, "H")
    ws.Cells.ClearContents
    
    Call mth_SetCell1DArr(vArr, rngStartCell, "V")
    
    Set rngStartCell = Nothing

End Sub


'*************************************************************************
'機能   :
'戻り値 :
'ARG1   :
'説明   :
'*************************************************************************
Public Sub mth_SetCell1DArr( _
                                vArr() As Variant, _
                                ByVal rngStartCell As Range, _
                                ByVal direction As String _
                                )

    '=======================
    '//
    '=======================
    Dim lRowMax As Long:
    Dim lColMax As Long:
    
    Select Case direction
    Case "H"
        lRowMax = 1
        lColMax = UBound(vArr, 1) - LBound(vArr, 1) + 1
        
        '※出力サイズの設定が必要
        rngStartCell.Resize(lRowMax, lColMax).Value = vArr
    
    Case "V"
        lRowMax = UBound(vArr, 1) - LBound(vArr, 1) + 1
        lColMax = 1
        
        '※出力サイズの設定が必要
        rngStartCell.Resize(lRowMax, lColMax).Value = WorksheetFunction.Transpose(vArr)
    
    End Select
    
    
    
End Sub

配列２D　→　セルに出力

'■■■■■■■■■■■■■■■■■■■■■■■■■
'// 配列2Dをセルに出力
'//
'■■■■■■■■■■■■■■■■■■■■■■■■■
Public Sub psub_配列2Dをセルに出力()


    '// 出力データ生成
    Dim vArr(2, 5) As Variant
    
    Dim r As Long, c As Long
    For r = LBound(vArr, 1) To UBound(vArr, 1)
        For c = LBound(vArr, 2) To UBound(vArr, 2)
            vArr(r, c) = CStr(r) & CStr(c)
        Next c
    Next r
    
    '// 出力
    Dim ws02 As Worksheet: Set ws02 = ThisWorkbook.Worksheets("WS02")
    Dim rngStartCell As Range
    Set rngStartCell = ws02.Range("B2")
    
    ws02.Cells.Clear
    Call mth_SetGetCellValArr(vArr, rngStartCell)
    
    Set rngStartCell = Nothing
    Set ws02 = Nothing

End Sub

'*************************************************************************
'機能   :
'戻り値 :
'ARG1   :
'説明   :
'*************************************************************************
Public Sub mth_SetGetCellValArr( _
                                vArr() As Variant, _
                                rngStartCell As Range _
                                )

    '=======================
    '//
    '=======================
    Dim lRowMax As Long:    lRowMax = UBound(vArr, 1) - LBound(vArr, 1) + 1
    Dim lColMax As Long:    lColMax = UBound(vArr, 2) - LBound(vArr, 2) + 1
    
    '※出力サイズの設定が必要
    rngStartCell.Resize(lRowMax, lColMax).Value = vArr
    
    
End Sub

【参考 】

【VBA入門】配列総まとめ(初期化、ループ操作、コピー、結合、比較) | 侍エンジニア塾ブログ（Samurai Blog）

【VBA入門】配列総まとめ(初期化、ループ操作、コピー、結合、比較) | 侍エンジニアブログ

配列の宣言、初期化、再定義

配列の宣言、定義
Arrayで初期化
ReDimで再定義
Eraseで配列のメモリを解放
2次元配列(多次元配列)の場合

セルと配列

セルの値を要素に代入
要素の値をセルに格納
配列の要素数を取得

ループで配列の要素を操作

Forループ
For Each

配列をコピー

Sortで配列の要素をソート

※Excelシートを使用

Filterで配列の要素を検索

要素を追加、削除

要素を削除

Joinで配列の要素を結合
JoinとSplitで配列を連結

配列同士を比較

C#：TOP

C#

C ＃

クラス

C#：クラス - プログラミングのメモ

文字列

■文字列
C#：文字列 - プログラミングのメモ"

String型

・string型の基本
・string型の初期化
・エスケープシーケンス
・＠（逐語型文字列）
・文字列　比較
・文字列　判定
・文字列　分割
・文字列　置換
・前後の空白取り除く
・文字数
・文字列－数値　変換
・書式
・数値の「0」パディング
・正規表現

Char型
StringBuilder

配列／コレクション

C#：配列

C#：コレクション

ADO／Access

C#：ADO（接続型）
C#：ADO（非接続型）
C#：ADO:Access
C#：ADO:Excel

DataSet／DataTable

■データテーブル C#：データテーブル - プログラミングのメモ"

カラムの追加 ／ データの追加 ／
Select(メソッド,LINQ) ／Sort(メソッド,LINQ) ／
集計(Computeメソッド MAX,MIN, SUM, AVE)

【C#入門】DataTableの使い方(Select、Sort、Compute、LINQも解説) | 侍エンジニアブログ"

LINQ

C#：LINQ - プログラミングのメモ"

INIファイル

INIファイル

ファイル／フォルダ

C#：ファイル／フォルダ - プログラミングのメモ"

WinAPI

DLL や Win32 API の関数を C# から呼び出す(「P/Invoke Interop Assistant」)

Winフォーム

フォーム

C#：Winフォーム：フォーム - プログラミングのメモ"

・プロパティ
　　ENT割り当て：AcceptButton
　　ESC割り当て：CancelButton
・ダイアログフォームのボタンを押しても閉じないようにする
・ダイアログフォーム
　　DialogResult

データグリッドビュー

■データグリッドビュー

データグリッドビュー

テキストボックス

C#：Winフォーム：テキストボックス - プログラミングのメモ"

・[Ent]で次へ（TabStrip）

リッチテキストボックス

C#：Winフォーム：リッチテキストボックス - プログラミングのメモ"

コンボボックス

  • クリア
  • 追加
            this.cbo.Items.Clear();
            this.cbo.Items.Add(item);

リストボックス

  • クリア
  • 追加（1項目ずつ、配列）
  • 削除（index、項目）
  • 選択・取得・解除
  • 複数選択
  • 選択項目を取得（複数）
            this.lst.Items.Clear();

           // 
            this.lst.Items.Add(item);

            // 配列で追加 1
            string[] sarr = new string[] { "1", "2", "3", "4", };
            this.lst_Sheets.Items.AddRange(sarr);
            this.Refresh();

            // 配列で追加 2
            List<string> slst = new List<string>();
            slst.Add("a");
            slst.Add("b");
            slst.Add("c");
            slst.Add("d");
            this.lst_Sheets.Items.AddRange(slst.ToArray());
            this.Refresh();

            // 削除　index,項目名
            this.lst_Sheets.Items.RemoveAt(0);
            this.lst_Sheets.Items.Remove("b");

            // 選択、取得、解除
            this.lst_Sheets.SelectedIndex = 0;
            Debug.Print(
                        this.lst_Sheets.SelectedIndex.ToString() + " , "
                        + this.lst_Sheets.SelectedItem.ToString()
                        );
            this.Refresh();

            this.lst_Sheets.SelectedItem = "a";
            Debug.Print(
                        this.lst_Sheets.SelectedIndex.ToString() + " , "
                        + this.lst_Sheets.SelectedItem.ToString() 
                        );
            this.Refresh();

            this.lst_Sheets.ClearSelected();

ListView

C#：ListView - プログラミングのメモ

TreeView

C#：TreeView - プログラミングのメモ

C＃：Excel

C#：Excel：COM - プログラミングのメモ"

C#：Excel：NPOI - プログラミングのメモ"

C#：Excel：ClosedXML - プログラミングのメモ"

C#：Excel：ExcelDataReader - プログラミングのメモ"

C#：Excel：ADO - プログラミングのメモ"

C＃ Excel

C#：Excel
ExcelDataReader で XLS と XLSX の両方を読込む方法



C#からExcelを操作する(PIAその1)

ExcelDataReader

C#：Excel：ExcelDataReader - プログラミングのメモ

Tips

C＃ Tips

■商と余りを同時に求める

[C#]剰余演算子(%)での余りの求め方とは？配列やList要素に対する余り・マイナス値に対する余り | [C#]剰余演算子(%)での余りの求め方とは？配列やList要素に対する余り・マイナス値に対する余り.NETコラム

ウェブスクレイピング

title取得：ウェブスクレイピング処理@C#【入門編】 | キャスレーコンサルティング株式会社"

参考

C# チュートリアル
参考サイト
C# カテゴリ

その他

DOSコマンドを実行

・DOSコマンドを実行して出力データを取得するーdobon.net

経過時間

・経過時間　分単位
　（dtFin - dtStart）.TotalMinute.ToString("0.00");

ダブルコーテーション外し

・ダブルコーテーション外し
　.Trim(new char[]{'"'});

URLからTitleを取得

URLからTitleを取得

進数変換

C#：Tips：進数変換 - プログラミングのメモ"

ACCDB

プラットフォーム： x64

using System;
using System.Collections.Generic;
using System.Linq;
using System.Text;
using System.Threading.Tasks;

//Microsoft ADO Ext.6.0 for DLL and Security
using ADOX;

namespace Excel_COM_2.AccDB
{
    class clsAccDB
    {
        public static void CreateAccdb()
        {
            //ADOX.Catalog cat = new Catalog();
            //    @"Data Source=D:\test.accdb;" +
            //    "Jet OLEDB:Engine Type=6");

            //cat = null;

            ADOX.Catalog cat = new ADOX.Catalog();
            //ADODB.Connection db1 = cat.Create("Provider='Microsoft.Jet.OLEDB.4.0';Data Source=" + @"D:" + @"\test1.mdb;Jet OLEDB:Engine Type=5");
            //ADODB.Connection db2 = cat.Create("Provider='Microsoft.Jet.OLEDB.4.0';Data Source=" + @"D:" + @"\test2.accdb;Jet OLEDB:Engine Type=5");

            ADODB.Connection db3 = cat.Create("Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" + @"D:" + @"\test3.accdb;Jet OLEDB:Engine Type=6");
            //cat.ActiveConnection = ConStr;


            //db1.Close();
            //db2.Close();
            db3.Close();
        }

    }
}

Python：学習03：独習

Python

第1章　イントロダクション

1.1 Pythonとは？

1.2 Pythonの歴史と現状

1.3 Pythonアプリを開発／実行するための基本環境

1.4 Pythonプログラミングの基本

1.1 hello.py

hello = 'hello world'
# print
print(hello)

print('5' , '3', '7' , sep =';', end = 'end')
# 5;3;7end

1.5 Pythonの基本ルール

1.6 開発／学習の前に押さえておきたいテーマ

第2章　Pythonの基本

2.1 変数

2.1

2.2 データ型

第3章　演算子

3.1 算術演算子

3.2 代入演算子

3.3 比較演算子

3.4 論理演算子

3.5 ビット演算子

3.6 演算子の優先順位と結合則

第4章　制御構文

条件分岐

繰り返し処理

ループの制御

例外処理

第5章　標準ライブラリ【基本】

ライブラリの分類

文字列の操作

日付／時刻の操作

第6章　標準ライブラリ【コレクション】

シーケンス型

セット（集合）型

辞書（dict）型

第7章　標準ライブラリ【その他】

正規表現

ファイル操作

ファイルシステムの操作

HTTP経由でコンテンツを取得する

その他の機能

第8章　ユーザー定義関数

ユーザー定義関数の基本

変数の有効範囲（スコープ） 引数のさまざまな記法 関数呼び出しと戻り値

第9章　ユーザー定義関数【応用】

デコレーター

ジェネレーター

関数のモジュール化

非同期処理

ドキュメンテーション

第10章　オブジェクト指向構文

クラスの定義

カプセル化

継承

ポリモーフィズム

第11章　オブジェクト指向構文【応用】

例外処理

特殊メソッド

データクラス

イテレーター

メタクラス