Excel VBA質問箱 IV

当質問箱は、有志のボランティア精神のおかげで成り立っています。
問題が解決したら、必ずお礼をしましょうね。
本サイトの基本方針をまとめました。こちら をご一読ください。

投稿種別の選択が必要です。ご注意ください。
迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。


37902 / 76732 ←次へ | 前へ→

【43976】Re:ソートについて
回答  Kein  - 06/10/31(火) 15:47 -

引用なし
パスワード
   実データは数値もピリオドも半角ですね ? で、日付形式になっているわけ
ではなくて、単に数値とピリオドを打ち込んだだけの値であるとします。
その範囲を選択して、以下のコードを実行してみて下さい。
長くて分かりにくいコードですが、いちおうこちらのテストは成功しています。

Sub MySort()
  Dim C As Range
  Dim Ary As Variant
 
  If TypeName(Selection) <> "Range" Then Exit Sub
  With Selection
   If .Columns.Count > 1 Then Exit Sub
   If .Areas.Count > 1 Then Exit Sub
   If InStr(1, .Cells(1).Value, ".") = 0 Then Exit Sub
   Application.ScreenUpdating = False
   .Offset(, 1).EntireColumn.Resize(, 2).Insert xlShiftToRight
   .TextToColumns DataType:=xlDelimited, Other:=True, _
   OtherChar:="."
   .Resize(, 3).Sort Key1:=.Columns(1), Order1:=xlAscending, _
   Key2:=.Columns(2), Order2:=xlAscending, Key3:=.Columns(3), _
   Order3:=xlAscending, Header:=xlGuess, _
   Orientation:=xlSortColumns
  End With
  For Each C In Selection
   With WorksheetFunction
     Ary = .Transpose(.Transpose(C.Resize(, 3).Value))
   End With
   C.Value = Join(Ary, ".")
  Next
  Selection.Offset(, 1).EntireColumn.Resize(, 2).Delete xlShiftToLeft
  Application.ScreenUpdating = True
End Sub

0 hits

【43966】ソートについて Yoshi 06/10/31(火) 12:14 質問
【43970】Re:ソートについて ひげくま 06/10/31(火) 12:51 発言
【43973】Re:ソートについて Jaka 06/10/31(火) 15:04 発言
【43975】Re:ソートについて Jaka 06/10/31(火) 15:13 発言
【43976】Re:ソートについて Kein 06/10/31(火) 15:47 回答

37902 / 76732 ←次へ | 前へ→
ページ:  ┃  記事番号:
2610219
(SS)C-BOARD v3.8 is Free