質問: ファイル名「1.jpg ~10.jpg~」のソート ただ今、エクセルのvbaを使って 複数の写真ファイルを一気に貼り付けてjpegに変換するプログラムを作っています。 だいたいはできたのですが、一つ壁にぶつかりました。 アルゴリズムは指定したフォルダのファイル名を取得し、それをリスト用のシートに出力し、使用者に必要なファイルを取捨選択してもらうようにしています。 フォルダのファイル名は下記urlのサンプルから使わせていただいています。 http://www.asahi-net.or.jp/~ef2o-inue/vba_o/sub05_110_080.html しかし、これを使うと、 「1.jpg、2.jpg~10.jpg・・・」のファイル名を取得すると、 「1.jpg、10.jpg、2.jpg・・・」 という風になります。これを回避するには現状「01.jpg、02.jpg~10.jpg・・・」と名前をつけるしかないのですが、不特定多数の人に使わせるので、出来るだけ汎用性を持たせたいと思っています。 例えば 「テスト1-1.jpg、テスト1-2.jpg~テスト1-10.jpg・・・ テスト10-1.jpg、テスト10-2.jpg~テスト10-10.jpg・・・ テスト11-1.jpg、テスト11-2.jpg~テスト11-10.jpg・・・」 というファイル名を上の通りに並べ変えるとしたら、どうすればいいでしょうか? 難しい場合は 「01.jpg、02.jpg~10.jpg・・・」 の時だけでもいいのでよろしくお願いします。
回答: 仮にa2以下に書き出されたファイル名をソートする場合、 sub try() const mx as long = 5 '取り敢えず各数値最大5桁の設定 dim target as range '並べ替え対象セル範囲 dim r as range 'loop用 dim rep as string 'format関数用 dim tmp as string '整形前value dim ret as string '整形後text dim s as string '文字1個 dim ss as string '連続数値文字 dim x as long 'len dim p as long '桁数記憶用 dim i as long dim j as long application.screenupdating = false '並べ替え対象のセル範囲をセット。 'サンプルとして(a2:a列最終行) set target = range("a2", cells(rows.count, 1).end(xlup)) rep = string(mx, "0") for each r in target tmp = r.value x = len(tmp) + 1 '整形後text長をmaxで設定 ret = space(x * mx) p = 0 j = 1 '1文字ずつloop for i = 1 to x s = mid$(tmp, i, 1) if isnumeric(s) then '数値だったら連続数をcountして連結 p = p + 1 ss = ss & s else if p > 0 then 'format関数で桁合わせて連結 mid$(ret, j, mx) = format$(ss, rep) j = j + mx p = 0 ss = empty end if '数値以外を連結 mid(ret, j, 1) = s j = j + 1 end if next '整形後textをふりがなにふる r.phonetic.text = left$(ret, j) next 'ふりがなsort target.sort key1:=target.item(1), order1:=xlascending, _ header:=xlno, ordercustom:=1, _ matchcase:=false, orientation:=xltoptobottom, _ sortmethod:=xlpinyin application.screenupdating = true set target = nothing end sub ..こんな感じで。 地道loop案なのでちょっと遅いかもしれませんが。