・[プログラム][ExcelVBA]「コンソールログビューア ver0.13」進捗
的確だった Google 先生の回答も徐々にレスポンスが悪くなってきております。
誰もやってないか直面してないのか、そもそも実現不可能なのかと。
・ListBox 内項目を全て選択する
Dim count As Long With ListBox1 For count = 0 To .ListCount - 1 If Not .Selected(count) Then .Selected(count) = True End If Next count End With
一般的な記述ですが、1万行越えのデータでやると15 〜 30 秒くらい待たされます
(2000 年代中盤頃のスペック)。
ListBox1.SetFocus SendKeys "{HOME}+({END})"
この場合キーストロークを ListBox コントロールに対して行うことで
一瞬にして決着が付きます(HOME で行頭に移動→ Shit+END で行末までを選択と同じ)。
・ListBox 内項目をクリップボードにコピーする
標準モジュール
'クリップボード操作用 Public Declare Function OpenClipboard Lib "user32" (ByVal hwnd As Long) As Long Public Declare Function CloseClipboard Lib "user32" () As Long Public Declare Function EmptyClipboard Lib "user32" () As Long
UserForm1
'クリップボード書出用 Dim CB As New DataObject 'ListBox 内項目取込用 Dim listData As String 'ListBox 内最終行数設定用 Dim countMax As Long 'ListBox 内項目の現在行用 Dim countNow As Long 'クリップボードを初期化 Call OpenClipboard(0&) Call EmptyClipboard Call CloseClipboard With ListBox1 '現在行から ListBox 最終行まで見て、リスト選択行のみを、項目タブ区切りで取込む For countNow = 0 To CountMax If .Selected(countNow) Then listData = listData & .List(countNow, 0) & vbTab listData = listData & .List(countNow, 1) & vbTab listData = listData & .List(countNow, 2) & vbCrLf End If Next countNow End With '生成された取込データをクリップボード用オブジェクトに書出する CB.SetText listData '生成の完了したデータをクリップボードにコピーする CB.PutInClipboard
これも駄目だった例です。
String 型の文字数上限が 20 憶文字なので、一見すれば万行でも対応出来そうですが、
追記の度に中身を保持しつつリサイズが掛かっていては幾らメモリを多く積んでても結構な処理待ちが発生しますし、
メモリリソースの乏しい環境ではフォームから応答が途絶えるかも知れません。
UserForm1
'クリップボード書出用 Dim CB As New DataObject 'ListBox 内項目取込用 Dim listData As String 'ListBox 内項目行数設定用 Dim countMax As Long '1度の ListBox 内項目取込の行数上限を設定する Const COUNT_CYCLE As Long = 1000 '1回の取込上限に合わせて、現在行・現在取込範囲を保持する為の変数 Dim countNow As Long Dim countStart As Long Dim countEnd As Long 'クリップボードを初期化 Call OpenClipboard(0&) Call EmptyClipboard Call CloseClipboard With ListBox1 'ListBox の読取範囲と読取開始行を設定する countNow = 0 countMax = .ListCount - 1 'クリップボード用オブジェクトを初期化する CB.SetText "" '現在行が読取範囲を超えるまで処理を続ける Do While countNow <= countMax 'ListBox 内項目読取用変数をクリアする listData = "" '現在行(前回未処理行)をこれから処理する範囲の開始行とする countStart = countNow '次の最終行を、現在行+行数上限に設定する countEnd = countStart + COUNT_CYCLE - 1 '但し、最終行が読取範囲を超える場合、読取範囲を最終行に設定する If countEnd > countMax Then countEnd = countMax End If '現在行から最終行まで見て、リスト選択行のみを、項目タブ区切りで取込む For countNow = countStart To CountEnd If .Selected(countNow) Then listData = listData & .List(countNow, 0) & vbTab listData = listData & .List(countNow, 1) & vbTab listData = listData & .List(countNow, 2) & vbCrLf End If Next countNow '生成された取込データをクリップボード用オブジェクトに追記する CB.SetText CB.GetText & listData Loop '生成の完了したデータをクリップボードにコピーする CB.PutInClipboard End With
これでも低スペック環境じゃマズイでしょうけど。
現環境で言えば 1000 行程度なら 0.3 秒程度で応答有りだったので小分けで取得というアプローチで対処しました。
1 万 6 千行ちょっとで 4 〜 5 秒掛かっちゃいますけど。
少し前から速度アップに工夫を強いられ続けてるんですが、流石に辟易してきた感は否めません(苦笑)。
その他の実装等。
・スプラッシュスクリーン画像をスプラッシュスクリーン・バージョン情報ダイアログフォームに組み込み。
・アイコンリソースを修正・変更。
・[プログラム][C言語][NDS]「ブロック崩し」進捗01
最終的にゲームエンジンとして再利用可能な代物を想定してて、その辺りの構造を構想したり。
そんな先のことは後でいいって?