Powerpoint VBAを使おう!

Powerpoint VBAやExcelのVBAで遊んでいます。JavaScriptやJScript,HTAに最近はまってます。

毎年この時期はデータ処理。。

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

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

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

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

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

ですが,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

自分用メモが主のブログでもありますので,説明とかいろいろと省きまくりなのはスルーしてほしいところです。

一時シートをつくり,そこにデータを放り込んでソートオブジェクトにおまかせ,というやつです。

あと,ソートの結果の一部を利用したり,または,ほとんど利用するんだけど,数列分は消したいという作業をよくやるので,抽出する関数も用意しています。

Sheet1のデータを取り込んで,一部抽出したり,ソート結果をさらに抽出する,という作業を テスト や テスト2
とかでやってみてますが,見た目にはまともに動いてそうでした。。

結局,速いアルゴリズムが優れたソートを自分はあまり実装できず,できてバブルソートだったりするので,

ExcelならSortオブジェクト使い倒してしまえ,という気分で作ったものです。

いくつキー与えてもやってくれるし,このマクロ組んでたら,Sortにcustomorderが使えるというのに今更ながらに知って驚いたり,

やっぱりいろいろと気楽にやってみるもんだなぁと思ったところです。。


--
わたしがいる学校ではそろそろ文化祭。

同僚に突然仕事を振られて,準備期間ほんのちょっとなのに 販売で使うシステムを組まされたりしています。

かなり以前に,小さなテキストメモみたいなものを吐き出して共通に見れるフォルダに放り込み,それをデータとして使う,,というシステムを作ったことがありました。

きちんとルール作りをすれば,データはその1KB程度のテキストがたくさん存在するだけであり,Excelが固まってもデータはほとんど消えることなく,

システムも小さくて済む。とても気楽に多人数でデータを扱えるシステムができている気がしています。

まさかこんなところで日の目を見るとは思わないものづくりでしたが,いつどんなものが役に立つかわからないものだなぁと思う。

思いつきは役に立とうが立つまいが一度は形にして,蓄積していけばいつか時間がないときにささっと対応できるなぁ,と2年ほど前の自分をほめつつ,

極めて短い準備期間なので,不具合をとても不安にも思いつつ作業しているところです。。