インストールレスプログラミング( ´ー`)

VBA , JavaScript , HTAなど 365アプリはインストール必要ですが、仕事に無いケースはほぼないから(・_・;)

あれれ(;´▽`A``

VBAでいろんな作業をしつつ,データ処理ばっかりやっているので,ほんとここには何も書けていないんですが,

以前から不思議なことが1点と,今回うまくいかなくて困っていることが1点。

不思議なことは,Collectionを使っているとき,突然強制終了をすること。

まぁまぁ頻繁にです。

下記のコードでもよく強制終了される。

せめてエラーを吐いて怒るくらいにしてほしいのにな。

でも,Excelを起動しなおすと,普通にコードは動いてしまい,どこかおかしいわけではないようなんです。

頻繁に強制終了されるのは けっこうストレス(; ・`д・´)



うまくいかなかったものは自己解決しました。

ソートを書くのが大変なので,入れなおす時に評価しながら入れて終わらせてしまおうという考え方をしました。

入れ替えを頻繁にしないでいいので,シンプルだし,人の感覚で並び替えるのってこんなかんじだなぁと思いながら作りました。

Sub ソース科目取得()
    Dim dic As Scripting.Dictionary
    Dim i As Long, j As Long, k As Long, l As Long
    Dim SourceSht As Worksheet: Set SourceSht = ThisWorkbook.Worksheets("ソース")
    Dim arr科目 As String, 時間割行番号 As Long
    Dim tmp科目クラス As String
    Dim col As Collection, flg As Boolean
    i = 2
    Do
        時間割行番号 = Me.Cells(i, 1)
        Set dic = New Dictionary
        Set col = New Collection
        arr科目 = ""
        
        For j = 4 To 33
            tmp科目クラス = SourceSht.Cells(時間割行番号, j) & SourceSht.Cells(時間割行番号 + 1, j)
            If tmp科目クラス <> "" And tmp科目クラス <> "※※" Then dic(tmp科目クラス) = 1
        Next
        l = 1
        For j = 0 To dic.Count - 1
            tmp科目クラス = dic.Keys(j)
            flg = False
            If l = 1 Then
                col.Add tmp科目クラス
                flg = True
            Else
                For k = 1 To col.Count
                    If tmp科目クラス < col(k) Then
                        col.Add tmp科目クラス, before:=k
                        flg = True
                        Exit For
                    End If
                Next
            End If
            If flg = False Then col.Add tmp科目クラス
            l = l + 1
        Next
        Stop
        For j = 1 To col.Count
            arr科目 = arr科目 & "■" & col(j)
        Next
        Me.Cells(i, 4) = Mid(arr科目, 2)
        i = i + 1
    Loop Until Me.Cells(i, 1) = ""
End Sub

f:id:chemiphys:20170408024932p:plain