🧙‍♂️

ExcelVBAで特定のデータ範囲をソートしてから配列に格納する

2022/04/23に公開約4,300字

シートが存在するか確認するFunctionプロシージャ

'特定のシートがあるか検索
'返り値はBoolean
Private Function F_SearchOneSheet(ByVal arg_SheetName As String) As Boolean
    
    Dim checkSheet As Worksheet
    
    For Each checkSheet In Sheets
        If checkSheet.Name = arg_SheetName Then
            F_SearchOneSheet = True
            Exit Function
        End If
    Next
    
    F_SearchOneSheet = False
    
End Function

https://zenn.dev/webdebris/articles/87aaa0b48b37b6

特定のデータ範囲をソートするFunctionプロシージャ

'特定のデータ範囲をソートする
'データ範囲はEndステートメントで確定
'引数でKeyを渡さないといけない
'Keyは”A1”の形式で渡す(文字列)
'1行目はタイトル行であると想定

Private Sub S_SortRange(ByVal arg_sortSheet As Worksheet, ByVal arg_startRow As Long, arg_startColumn As Long, ByVal arg_sortRangeString As String)

    Dim sortRange As Range
    Dim lastRow, lastColumn As Long
    
    arg_sortSheet.Activate
    
    lastRow = Cells(arg_startColumn, 1).End(xlDown).Row
    lastColumn = Cells(arg_startRow, 1).End(xlToRight).Column
    
    Set sortRange = Range(Cells(2, 1), Cells(lastRow, lastColumn))
    
    sortRange.Sort Key1:=Range(arg_sortRangeString), order1:=xlAscending
    
End Sub

https://zenn.dev/webdebris/articles/5b581f28c6ac50

特定のデータ範囲をRangeで返すFunctionプロシージャ

'特定のデータ範囲をRangeで返す
'データ範囲はEndで特定
'返り値はRange
'受け取る変数はVariantであること
Private Function F_GetRange(ByVal arg_getSheet As Worksheet, ByVal arg_startRow As Long, arg_startColumn As Long) As Range
    
    Dim lastRow, lastColumn As Long
    
    arg_getSheet.Activate
    lastRow = Cells(Rows.Count, arg_startColumn).End(xlUp).Row
    lastColumn = Cells(arg_startRow, Columns.Count).End(xlToLeft).Column
    Set F_GetRange = Range(Cells(1, 1), Cells(lastRow, lastColumn))
    
End Function

https://zenn.dev/webdebris/articles/6fa6ceed093657

特定のデータ範囲をソートして配列に格納するExcelVBA

Sub S_Main()
    
    Dim ZennList As Variant
    
    Dim searchSheetName As String
    Dim hasOneSheet As Boolean
    Dim sortSheetName As String
    Dim sortSheet As Worksheet
    Dim sortStartRow, sortStartColumn As Long
    Dim sortKey As String
    Dim getSheetName As String
    Dim getSheet As Worksheet
    Dim getStartRow, getStartColumn As Long
    
    searchSheetName = "シート名"
    
    hasOneSheet = F_SearchOneSheet(searchSheetName)
    
    If hasOneSheet = False Then
        MsgBox "シート名『" + searchSheetName + "』が存在しません"
        Exit Sub
    End If
    
    sortSheetName = searchSheetName
    Set sortSheet = ActiveWorkbook.Worksheets(sortSheetName)
    sortStartRow = 1
    sortStartColumn = 1
    sortKey = "A1"
        
    Call S_SortRange(sortSheet, sortStartRow, sortStartColumn, sortKey)
    
    getSheetName = sortSheetName
    Set getSheet = ActiveWorkbook.Worksheets(getSheetName)
    getStartRow = 1
    getStartColumn = 1
    
    ZennList = F_GetRange(getSheet, getStartRow, getStartColumn)
    
End Sub


'特定のシートがあるか検索
'返り値はBoolean
Private Function F_SearchOneSheet(ByVal arg_SheetName As String) As Boolean
    
    Dim checkSheet As Worksheet
    
    For Each checkSheet In Sheets
        If checkSheet.Name = arg_SheetName Then
            F_SearchOneSheet = True
            Exit Function
        End If
    Next
    
    F_SearchOneSheet = False
    
End Function

'特定のデータ範囲をソートする
'データ範囲はEndステートメントで確定
'引数でKeyを渡さないといけない
'Keyは”A1”の形式で渡す(文字列)
'1行目はタイトル行であると想定
Private Sub S_SortRange(ByVal arg_sortSheet As Worksheet, ByVal arg_startRow As Long, arg_startColumn As Long, ByVal arg_sortRangeString As String)

    Dim sortRange As Range
    Dim lastRow, lastColumn As Long
    
    arg_sortSheet.Activate
    
    lastRow = Cells(arg_startColumn, 1).End(xlDown).Row
    lastColumn = Cells(arg_startRow, 1).End(xlToRight).Column
    
    Set sortRange = Range(Cells(2, 1), Cells(lastRow, lastColumn))
    
    sortRange.Sort Key1:=Range(arg_sortRangeString), order1:=xlAscending
    
End Sub

'特定のデータ範囲をRangeで返す
'データ範囲はEndで特定
'返り値はRange
'受け取る変数はVariantであること
Private Function F_GetRange(ByVal arg_getSheet As Worksheet, ByVal arg_startRow As Long, arg_startColumn As Long) As Range
    
    Dim lastRow, lastColumn As Long
    
    arg_getSheet.Activate
    lastRow = Cells(Rows.Count, arg_startColumn).End(xlUp).Row
    lastColumn = Cells(arg_startRow, Columns.Count).End(xlToLeft).Column
    Set F_GetRange = Range(Cells(1, 1), Cells(lastRow, lastColumn))
    
    
End Function


Discussion

ログインするとコメントできます