[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]
『数字を昇順に並べ替え』(123)
0始まりでない数字を昇順に並べ替えたいのですが・・・。
ファイル名をエクセルに転記するVBAを書いていて、
B1F
1F
2F
3F
11F
12F
上の順番に並べたいのですが、実際には
11F
12F
1F
2F
3F
B1F
となってしまいます。
ファイル名を変えずに、VBAで望み通りの並びに変えるにはどうしたらよいでしょうか?
< 使用 Excel:Excel2013、使用 OS:Windows10 >
(渡辺ひかる) 2019/08/15(木) 15:41
回答ではありません。疑問点だけです。
この部分は、こう変換して考えればいいのかな、と思いますが、 ↓ ↓ >1F 01F >2F 02F >3F 03F >11F 11F >12F 12F
この部分はどう考えるとその順になるんですか? 普通、アルファベットの方が数字より大きいと判断されます。 ↓ B1F 1F
あと、 数値の前のアルファベットには、どんなパターンが有るんですか? 数値の後のアルファベットには、どんなパターンが有るんですか?
(半平太) 2019/08/15(木) 15:46
(マナ) 2019/08/15(木) 16:23
>(M2F(中間2階)というのもありますがほとんどないので今回はムシしています) 対応済み データがA1からの設定で
Sub test() Dim a, i As Long With Range("a1", Range("a" & Rows.Count).End(xlUp)) a = .Resize(, 2).Value For i = 1 To UBound(a, 1) If a(i, 1) Like "[0-90-9]*" Then a(i, 2) = Val(StrConv(a(i, 1), 8)) ElseIf a(i, 1) Like "[BB]*" Then a(i, 2) = Val(Mid$(StrConv(a(i, 1), 8), 2)) - 100 ElseIf a(i, 1) Like "[MM]*" Then a(i, 2) = Val(Mid$(StrConv(a(i, 1), 8), 2)) + 0.1 Else a(i, 2) = 1000 End If Next mySort a .Value = a End With End Sub
Private Sub mySort(a) Dim i As Long, ii As Long, iii As Long, temp, flg As Boolean For i = LBound(a, 1) To UBound(a, 1) - 1 For ii = i + 1 To UBound(a, 1) If a(i, 2) > a(ii, 2) Then For iii = LBound(a, 2) To UBound(a, 2) temp = a(i, iii): a(i, iii) = a(ii, iii): a(ii, iii) = temp Next End If Next Next End Sub (seiya) 2019/08/15(木) 16:36 コードを簡素化 17:07
表示だけで良ければ、表示形式を「[=100]"RF";"B"0"F";0"F"」にする。 地下1階は-1、地下2階は-2、屋上階は100と入れる。 (100階以上ある建物があるならもっと大きな数で)
これで昇順で並べ替えはできます。 (コナミ) 2019/08/15(木) 16:56
作業列に、こんな感じの数式使えば楽なのに何で使おうとしないんですかね?
=IF(LEFT(A1,1)="B",-100,1)*SUBSTITUTE(SUBSTITUTE(A1,"F",""),"B","") (BJ) 2019/08/15(木) 18:24
↑ 何となく気分で -100 にしちゃったけど、単純に -1 で良かったかも。 (BJ) 2019/08/15(木) 18:35
=--SUBSTITUTE(SUBSTITUTE(A1,"B","-"),"F","") これで良かった。 (BJ) 2019/08/15(木) 22:41
>これはフロアを示していて、
これを最初に書いてもらえれば、すんなり理解できたのですが・・
マナさんのアドバイスのように、ユーザー定義リストを作成するのが、 あとあと楽になるのではないかと思います。
下記に、ユーザー定義リストを作成するコードを書いてみました 一度走らせれば、次回からは、ユーザー定義リストを指定してソートできます
Sub Macro1() Dim myAr As Variant Dim myStr As String Dim i As Long
myStr = "B1F"
For i = 1 To 99 myStr = myStr & "," & StrConv(i & "F", vbWide) Next
myAr = Split(myStr, ",")
Application.AddCustomList ListArray:=myAr
End Sub
(渡辺ひかる) 2019/08/16(金) 09:22
Option VBASupport 1
REM ***** BASIC *****
Sub Main
Dim wb As Workbook Dim arr As Variant Dim arr_F(1 To 7) As Variant ' データ数が8個としています。 Dim arr_F1(1 To 7) As Variant Dim data As String Dim i As Integer Dim cnt As Integer
Set wb = ThisWorkbook arr = wb.Sheets("Sheet1").Range("A2:A8") ' A2:A8セルにデータがあるものと仮定。
' arr(1) B1F
' ------------------------------------- ' データを数値に変換 ' ------------------------------------- cnt = 1 For i = 1 To 7 ' 先頭の文字列がBのものはマイナスとして配列に格納する If LEFT(arr(i,1),1) = "B" Then data = MID(arr(i,1),2) ' 先頭のBを除いた2文字目からデータを取得。 data = Replace(data,"F","") ' Fを消す。 arr_F(cnt) = -1 * Val(StrConv(data,vbNarrow)) ' 先頭の文字がBのときは-(マイナス)として扱う。ValとStrConvで全角文字列を数値に変換 cnt = cnt + 1
' 先頭の文字列がB以外のものは数値として配列に格納する Else data = arr(i,1) data = Replace(data,"F","") ' Fを消す。 arr_F(cnt) = Val(StrConv(data,vbNarrow)) ' ValとStrConvで全角文字列を数値に変換 cnt = cnt + 1 End If Next ' -------------------------------------
Call InsertionSort(arr_F, LBound(arr_F), UBound(arr_F)) ' 並べ替え(昇順) InsertionSortは必須。 関数の参考URL https://www.tipsfound.com/vba/02020 ' Call Reverse(arr_F) ' 降順 関数の参考URL https://www.tipsfound.com/vba/02021
' ------------------------------------- ' 数値をフロアデータに変換 ' ------------------------------------- cnt = 1 For i = 1 To 7 ' マイナスのものはBを-を消してBを前につけて配列に格納する If arr_F(i) < 0 Then data = -1*arr_F(i) ' マイナスをプラスに変換 data = StrConv(data,vbWide) ' 半角数字を全角数字に変換 arr_F1(cnt) = "B" & data & "F" ' B1Fなど cnt = cnt + 1
' プラスのものは全角に変換後、最後にFをつけて配列に格納する Else data = StrConv(arr_F(i),vbWide) ' 半角数字を全角数字に変換 arr_F1(cnt) = data & "F" ' 1Fなど cnt = cnt + 1 End If Next ' -------------------------------------
' B2:B8セルに出力(仮) For i = 1 To 7 wb.Sheets("Sheet1").Cells(i+1,2) = arr_F1(i) Next
End Sub
Sub InsertionSort(ByRef data As Variant, ByVal low As Long, ByVal high As Long)
https://www.tipsfound.com/vba/02020を参考に。 End Sub
Sub Reverse(ByRef data As Variant)
https://www.tipsfound.com/vba/02021を参考に。
End Sub
よろしくお願いいたします。
(akinobu) 2019/08/16(金) 14:54
何をよろしくかわからないです?
(閲覧者) 2019/08/16(金) 18:43
[ 一覧(最新更新順) ]
YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki.
Modified by kazu.