あれれ(;´▽`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