Excel VBA質問箱 IV

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

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


34744 / 76734 ←次へ | 前へ→

【47196】Re:都道府県名を含むをソートできない
発言  ichinose  - 07/3/4(日) 17:16 -

引用なし
パスワード
   こんばんは。

>当初はB列に都道府県名を取り出し、質問のArray関数を利用していましたが
>一度に行う方法はないかと思っています。

B列を作業領域として、キーを配置し、これを基にソートする・・、

これが一番簡単だと思いますし、Excelを使うならこの方法を使わないと
勿体無いですよ!!

とお断りした上で・・・、この作業領域を別の場所に置く方法です。

標準モジュールに
'================================================================
Sub main()
  Dim g0 As Long
  Dim myarray As Variant
  Call sort_set_list(Array("北海道", "青森県", _
      "岩手県", "宮城県", "秋田県", "山形県", "福島県", "茨城県", _
      "栃木県", "群馬県", "埼玉県", "千葉県", "東京都", "神奈川", _
      "新潟県", "富山県", "石川県", "福井県", "山梨県", "長野県", _
      "岐阜県", "静岡県", "愛知県", "三重県", "滋賀県", "京都府", _
      "大阪府", "兵庫県", "奈良県", "和歌山", "鳥取県", "島根県", _
      "岡山県", "広島県", "山口県", "徳島県", "香川県", "愛媛県", _
      "高知県", "福岡県", "佐賀県", "長崎県", "熊本県", "大分県", _
      "宮崎県", "鹿児島", "沖縄県"))
  g0 = 1
  Do Until Cells(g0, 1).Value = ""
    Call sort_put_ele(Left(Cells(g0, 1).Value, 3), Cells(g0, 1).Value)
    g0 = g0 + 1
    Loop
  g0 = 1
  myarray = sort_get_array(True)
  Do While TypeName(myarray) <> "Boolean"
    Range(Cells(g0, 1), Cells(g0 + UBound(myarray) - 1, 1)).Value = _
         Application.Transpose(myarray)
    g0 = g0 + UBound(myarray)
    myarray = sort_get_array()
    Loop
  Call sort_term
End Sub


別の標準モジュールに
'===================================================================
Option Explicit
Private sdic As object
'===================================================================
Sub sort_set_list(myarray As Variant)
  Dim sitem() As Variant
  Dim g0 As Long
  Set sdic = CreateObject("scripting.dictionary")
  For g0 = LBound(myarray) To UBound(myarray)
    sdic.Add myarray(g0), sitem()
    Next
End Sub
'===================================================================
Sub sort_put_ele(skey As Variant, sdata As Variant)
  Dim idx As Long
  Dim sarray As Variant
  If sdic.Exists(skey) Then
    sarray = sdic.Item(skey)
    On Error Resume Next
    idx = UBound(sarray) + 1
    If Err.Number <> 0 Then idx = 1
    ReDim Preserve sarray(1 To idx)
    sarray(idx) = sdata
    sdic.Item(skey) = sarray
    On Error GoTo 0
    End If
End Sub
'===================================================================
Function sort_get_array(Optional stt As Boolean = False) As Variant
  Static sidx As Long
  Static skey As Variant
  Dim wk As Long
  If stt Then
    skey = sdic.Keys
    sidx = LBound(skey)
    End If
  On Error Resume Next
  sort_get_array = False
  Do While sidx <= UBound(skey)
    sort_get_array = sdic.Item(skey(sidx))
    sidx = sidx + 1
    Err.Clear
    wk = UBound(sort_get_array)
    If Err.Number <> 0 Then
     sort_get_array = False
    Else
     Exit Do
     End If
    Loop
   On Error GoTo 0
End Function
'===================================================================
Sub sort_term()
  Set sdic = Nothing
End Sub


として、対象シートをアクティブにしてmainを実行してください。

尚、データはセルA1から入っているとします。
2 hits

【47184】都道府県名を含むをソートできない うまくいかない 07/3/4(日) 9:21 質問
【47185】Re:都道府県名を含むをソートできない かみちゃん 07/3/4(日) 10:22 発言
【47186】Re:都道府県名を含むをソートできない うまくいかない 07/3/4(日) 11:05 発言
【47187】Re:都道府県名を含むをソートできない かみちゃん 07/3/4(日) 11:21 発言
【47188】Re:都道府県名を含むをソートできない うまくいかない 07/3/4(日) 11:39 発言
【47189】Re:都道府県名を含むをソートできない かみちゃん 07/3/4(日) 14:03 発言
【47191】Re:都道府県名を含むをソートできない inoue 07/3/4(日) 14:11 発言
【47190】Re:都道府県名を含むをソートできない inoue 07/3/4(日) 14:06 発言
【47192】Re:都道府県名を含むをソートできない Kein 07/3/4(日) 15:06 回答
【47196】Re:都道府県名を含むをソートできない ichinose 07/3/4(日) 17:16 発言
【47198】Re:都道府県名を含むをソートできない うまくいかない 07/3/4(日) 21:10 お礼

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