毎年この時期はデータ処理。。 - インストールレスプログラミング( ´ー`)

教員をしていると，入試の時期が必ず来ます。

そろそろ，また今年の分の調整をし始めないといけません。

思えば，様々なアドバイスをいただき始めたのも，データ処理をどうするか，という話の頃から。

とてもありがたいことです。以前とはコードの書き方もけっこう変化しました。

そして，私はいつも同じ付近に考え方を戻して，いろんなことを気分でやるので，今回はある意味ふりだしに戻った感が否めません。

ですが，VBA組める同僚はほとんど出会わない職場ですので，他の人でも見てわかる，とか，自分が中身を忘れてもみればわかる・・・

そのようなものを求めるのもしょうがないのかなぁと思います。

infoment.hatenablog.com

Infomentさんのブログで配列のソートに取り組まれています。

PowerPointでものづくりをするときは否応なしにそっち方向でやっていかないといけないので，とても楽しみに様子を見させてもらってます。

わたしは，とりあえず今年は一時ワークシートを作ってそこで作業する，という方向に戻して考えようということにしました。

Stopでもそのあたりに入れておけば，ソートの途中経過など確認しやすいから，というのもありますね。

とりあえずてきとーに組んだのがこちら。Excel VBAです。

Function ソート(ソース As Variant, ParamArray Keys()) As Variant
    
    Dim Data As Variant, 行数 As Long, 列数 As Long
    If TypeName(ソース) = "Range" Then
        行数 = ソース.Rows.Count
        列数 = ソース.Columns.Count
        Data = ソース.Value
    Else
        行数 = UBound(ソース, 1)
        列数 = UBound(ソース, 2)
        Data = ソース
    End If
    
    Dim TempSht As Worksheet
    Set TempSht = ThisWorkbook.Worksheets.Add
    
    Dim s As Worksheet, No As Long, flg As Boolean
    Do
        No = No + 1
        flg = False
        For Each s In ThisWorkbook.Worksheets
            If s.Name = "作業用一時シート" & Format(No, "00") Then flg = True
        Next
    Loop Until flg = False
    TempSht.Name = "作業用一時シート" & Format(No, "00")

    Dim SObj As Sort, TempRng As Range, i As Long, j As Long
    Set TempRng = TempSht.Range(TempSht.Cells(1, 1), TempSht.Cells(行数, 列数))
    TempRng.Value = Data

    Set SObj = TempSht.Sort
    With SObj
        .SortFields.Clear
        .SetRange TempRng
        .Header = xlYes
        For i = 0 To UBound(Keys) - 1 Step 2
            .SortFields.Add Key:=TempRng.Cells(1, Keys(i)), Order:=Switch(Keys(i + 1) = True, xlAscending, Keys(i + 1) = False, xlDescending)
        Next
        .Apply
    End With
    
    ソート = TempRng.Value
    
    Application.DisplayAlerts = False
        TempSht.Delete
    Application.DisplayAlerts = True
    
    
End Function

Function 抽出(ソース As Variant, flg As Variant, ParamArray Keys()) As Variant
    Dim i As Long, j As Long, k As Long, l As Long, Flg2 As Boolean
    Dim 行数 As Long, 列数 As Long, tmp() As Variant
    
    行数 = UBound(ソース, 1)
    列数 = UBound(ソース, 2)
    
    If flg = True Then
        ReDim tmp(1 To 行数, 1 To UBound(Keys) + 1)
        For i = 1 To UBound(ソース, 1)
            k = 1
            For l = 0 To UBound(Keys)
                tmp(i, k) = ソース(i, Keys(l))
                k = k + 1
            Next l
        Next i
    Else
        ReDim tmp(1 To 行数, 1 To 列数 - UBound(Keys) - 1)
        k = 1
        For j = 1 To UBound(ソース, 2)
            Flg2 = True
            For l = 0 To UBound(Keys)
                If j = Keys(l) Then Flg2 = False
            Next
            If Flg2 = True Then
                For i = 1 To UBound(ソース, 1)
                    tmp(i, k) = ソース(i, j)
                Next
                k = k + 1
            End If
        Next
    End If
    
    抽出 = tmp
End Function

Sub テスト()
    Dim ret As Variant
    ret = 抽出(ソート(Sheet1.Range("a1").CurrentRegion, 8, True, 5, True), True, 5, 6, 7, 9)
    
    Sheet4.Cells(1, 1).Resize(UBound(ret, 1), UBound(ret, 2)).Value = ret
    Stop
End Sub

Sub テスト2()
    Dim a As Variant: a = Sheet1.Range("a1").CurrentRegion.Value
    Dim b As Variant: b = 抽出(a, False, 2, 3)
    Stop
End Sub