いつも大変お世話になっております。
Excel2003を使用しております。

ユーザーフォームに置いてある
コンボボックスのデータの順番が毎回変わるのですが、
指定順に並び替えたいです。

例えば、
東京
大阪
北海道
青森
沖縄
仙台
福岡
という順番でコンボボックスに入っている場合、

北海道
青森
仙台
東京
大阪
福岡
沖縄
という順番に自動で並べ替えたいのです。
項目は必ず全てあるわけではなく、

東京
北海道

だけの場合もあります。(コンボボックスの最後には必ず空白が1行あります)

Sub ComboboxNarabi()
Dim i As Long
Dim j As Long
Dim Count As Long
Dim Swap As String
Dim SortListData As Variant

SortListData = Array("北海道", "青森", "仙台", "東京", "大阪", "福岡", "沖縄", "")

Count = 0
For j = 0 To UBound(SortListData)
For i = 0 To ComboBox2.ListCount - 1
If ComboBox2.List(i) = SortListData(j) Then
Swap = ComboBox2.List(Count) '現在の位置の内容をSwapにコピー
ComboBox2.List(Count) = ComboBox2.List(i) '現在位置に、検索したワードをコピー
ComboBox2.List(i) = Swap 'もとの内容をコピー
Count = Count + 1
End If
Next
Next
End Sub


なんだか遠回りしているような気もします。
もう少し、良い方法はありますでしょうか?
以上、よろしくお願い致します!

このQ&Aに関連する最新のQ&A

A 回答 (1件)

こんにちは。



十分シンプルに纏っていますし、問題なく作動しますから、
そのままでもいいようにも思いますが。
一方で、何度も何度も忙しくリストの内容を書き換えるループが気になる、
ということであれば、理解、共感できる部分ではあります。
参考として、3例挙げてみます。
ここには書きませんが私個人の実務としては
今回のような複雑なソートの場合はADODBでSQLやRecordSet.Sort等を用いることが比較的多かったり、
ソートオーダーが可変な場合などではCollectionやDictionary等のオブジェクトを
配列ソートアルゴリズム等と組み合わせたり、とかもします。
より簡単に書けるものは簡単に済ませるようにも心がけていますけれども、、、。
書換えを考える時には、書換える意図を明確にしておくようにして、
一定の方向性を常に意識しながら書く様にするといいです。
今回は、複雑な処理は避けなるべく簡素に、実行プロシージャの編集が容易なもの、
という意図で3案挙げてみました。
メンテナンスに自信が持てる書き方を選ぶ、というのも、とても大切なことですので。

#余談。蛇足。
IF Then ステートメントには色々あります。
  If 条件 Then 真の処理 Else 偽の処理
のように1行で書くことだって出来るのですけれど、
これはまぁ、やり過ぎ、というか非常に読み難いので使いませんが、
  If 条件 Then Exit Sub
のような排他処理の書き方は、VBAでは定番です。
  If 条件 Then
    1ページに収まらない程の長ったらしい処理
  End If
のように書くとEnd Ifの由来を確認するのも面倒ですし、、、。
無論、サブルーチン化するなどの検討も必要ですが、
目にすることの多い例として、特にイベントプロシージャなどでは、
Exit Sub(1行で記す If ... Then ... ステートメント)の使いこなしは重要な基本です。

#余談2。
VBEコードペイン上のインデントを投稿に反映させる方法ですが、
私は投稿文をメモ帳で書いてから全文をコピペして投稿する習慣がある(自分に課している)ので、
メモ帳にて、半角スペース4つを全角スペース2つに全置換しておくことで、
インデント擬きを表示させています。
昔はコードに全角スペースなど言語道断と仰る方多かったですが、
現行のExcel環境では、全角スペース2つをVBEコードペイン上にコピペすれば、
正しくインデント(タブ、というより半角スペース4つ)に置換してくれるようにもなっています。

以下3例。

' ' 〓〓〓〓〓〓〓〓〓〓
Option Explicit

Private arrSortOrder ' ! モジュールで宣言。
' ' ↑ FnSortOrder用。頻繁に並べ替えをするならソートオーダーは固定した方が有利。

' ' ======== 1◆ベーシック版
' ' #せめて記述上だけでも。同じ事を繰り返さない(参照や取得は1回に纏める)ようにしてみる、とか。
Sub Re8668860b() ' ▼実行proc
Dim i As Long
Dim j As Long
Dim Count As Long
Dim Temp As String
Dim Swap As String
Dim SortListData As Variant

  SortListData = Array("北海道", "青森", "仙台", "東京", "大阪", "福岡", "沖縄", "")
  With ComboBox2
    Count = 0
    For j = 0 To UBound(SortListData)
      For i = 0 To .ListCount - 1
        Temp = .List(i)
        If Temp = SortListData(j) Then
          Swap = .List(Count) '現在の位置の内容をSwapにコピー
          .List(Count) = Temp '現在位置に、検索したワードをコピー
          .List(i) = Swap 'もとの内容をコピー
          Count = Count + 1
        End If
      Next
    Next
  End With
End Sub

' ' ======== 2◆配列操作List設定版(並べ替えは関数(配列変数))で
' ' #コンボボックスのリスト書換えを1回に纏める、とか。
Sub Re8668860c() ' ▼実行proc)
  With ComboBox2
    .List = FnSortOrder(.List)
  End With
End Sub
Function FnSortOrder(ByVal arrCurList As Variant) As Variant
Dim sBuf As String
Dim nUBO As Long
Dim nUBC As Long
Dim nRank As Long
Dim i As Long
Dim j As Long
  If Not IsArray(arrSortOrder) Then
    arrSortOrder = Array("北海道", "青森", "仙台", "東京", "大阪", "福岡", "沖縄", "")
  End If
  arrCurList = ComboBox2.List ' ! 二次元配列
  For j = 0 To UBound(arrSortOrder)
    For i = 0 To UBound(arrCurList)
      If arrCurList(i, 0) = arrSortOrder(j) Then
        sBuf = arrCurList(nRank, 0)
        arrCurList(nRank, 0) = arrCurList(i, 0)
        arrCurList(i, 0) = sBuf
        nRank = nRank + 1
      End If
    Next
  Next
  FnSortOrder = arrCurList
End Function

' ' ======== 3◆Excelのユーザー設定と作業シート(非表示)を事前に用意しておいて
' ' #Excelの並べ替え機能を活用し、実行側では何も考えないで済むようにする、とか。
Private Sub 初期設定()
Dim shSelected As Sheets
  Set shSelected = ActiveWindow.SelectedSheets
  With Worksheets.Add
    .Name = "Work"
    .Visible = xlSheetHidden
  End With
  shSelected.Select
  Application.AddCustomList Array("北海道", "青森", "仙台", "東京", "大阪", "福岡", "沖縄", "")
End Sub ' ↑ 実行は事前に、一度だけ。
Sub Re8668860e() ' ▼実行proc
  With ComboBox2
    .List = FnSortCustom(.List)
  End With
End Sub
Function FnSortCustom(ByVal arrCurList As Variant) As Variant
  With Sheets("work").Columns(1)
    .Value = Empty ' .ClearContents
    With .Resize(UBound(arrCurList) + 1)
      .Value = arrCurList
      .Sort Key1:=.Cells(1), Order1:=xlAscending, _
        Header:=xlNo, OrderCustom:=Application.CustomListCount + 1, _
        MatchCase:=True, Orientation:=xlTopToBottom, _
        SortMethod:=xlStroke, DataOption1:=xlSortNormal
      FnSortCustom = .Value
    End With
  End With
End Function
' ' ========
' ' 〓〓〓〓〓〓〓〓〓〓
    • good
    • 0
この回答へのお礼

回答ありがとうございます。
タブを入れたつもりが、入っていませんでした!
見づらいプログラムで申し訳ありませんでした。

おぉお、すごいです!
同じことをやるのに3パターンも考えられるなんて…
2次元配列って難しいですね!
プログラムを読むだけで精一杯です(苦笑

元々ある、Excelの並び替え機能が使えるとは思っていませんでした!
確かに、その方法なら今後も…使えそうな気がします!

If文の横にExit Sub などが基本ですか。
全然使っておりませんでしたorz
その横にEnd If をつける…のも良いのでしょうか?

中々、プログラムというのは奥が深いですね…!

ありがとうございました^^
大変参考になりました!

お礼日時:2014/07/08 15:39

このQ&Aに関連する人気のQ&A

お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!

このQ&Aを見た人はこんなQ&Aも見ています

このQ&Aを見た人が検索しているワード

このQ&Aと関連する良く見られている質問

Qコンボボックスへ降順に表示するには?

Formに貼り付けている ComboBox1 へ
シート(Date_Base)のリストを 降順で表示したいのですが
どのように コードを書けばいいのでしょうか?

Aベストアンサー

こんにちは。

最初に、正しく、Set rng = Range(....) の部分を設定してください。

シート・モジュール

Sub EnterData2Combo()
Dim Ar() As Variant
Dim rng As Range
Dim i As Long
Set rng = Range("A1:A10")
 ReDim Ar(rng.Rows.Count - 1)
 For i = 0 To rng.Rows.Count - 1
  Ar(i) = rng.Cells(i + 1).Value
 Next i
 Babble_Sort Ar()
 Me.ComboBox1.List = Ar()
End Sub
Sub Babble_Sort(ByRef Ar())
 Dim u As Long
 Dim i As Long
 Dim j As Long
 Dim t As Variant
 u = UBound(Ar())
 i = LBound(Ar())
 Do While i < u
  j = u
  Do While j > i
   If Ar(j) > Ar(i) Then '降順
    t = Ar(j)
    Ar(j) = Ar(i)
    Ar(i) = t
   End If
   j = j - 1
  Loop
  i = i + 1
 Loop
End Sub

こんにちは。

最初に、正しく、Set rng = Range(....) の部分を設定してください。

シート・モジュール

Sub EnterData2Combo()
Dim Ar() As Variant
Dim rng As Range
Dim i As Long
Set rng = Range("A1:A10")
 ReDim Ar(rng.Rows.Count - 1)
 For i = 0 To rng.Rows.Count - 1
  Ar(i) = rng.Cells(i + 1).Value
 Next i
 Babble_Sort Ar()
 Me.ComboBox1.List = Ar()
End Sub
Sub Babble_Sort(ByRef Ar())
 Dim u As Long
 Dim i As Long
 Dim j As Long
 Dim t As Variant...続きを読む

QVBA コンボボックスで選んだ値を取得するには

ユーザーフォーム上のコンボボックスから値を選択し、その値を変数として使いたいのですが、うまくいきません。

コンボボックスのコードで
Private Sub ComboBox1_Change()
moji1 = ComboBox1.Text
Range("A1").Value = moji1
のようにすれば、コンボボックスから値を選んだ時点でA1セルにその値をコピーできるのですが、同じユーザーフォーム上にあるコマンドボタンをクリックして実行する「マクロ1」にてこのmoji1という変数を使いたいのです。

マクロ1にて、上記と同じ
Range("A1").Value = moji1
というコードを記述しても、ユーザーフォームで選択した値が消えており、empty値となってしまいます。

原因をご存知の方はお教えください。

Aベストアンサー

原因については下記を参考にしてください。
http://pc.nikkeibp.co.jp/pc21/special/2007_gosa/eg5.shtml

Qリストボックスの並び替え

VB.NETについて質問です。
ボタン1をクリックしたら、テキストボックス1に入力した文字を、リストボックス1に登録するとします。
この時、名前、年齢を入力します。
これを、ボタン2、3、をクリックしたら、リストボックスの内容を、名前順、年齢順に並べ替えたいです。
どうしても分かりません。
並べ替えるにはどうしたらいいでしょうか?

Aベストアンサー

下記のコントロールとコードを追加すると実現できます。
他にも方法はあるのですが、自作のコントロールを作る必要があるので、
この方法が簡単だと思います。
前に作っていたものを少し改造したものなのでもしかしたら不具合があるかもしれません。
(エラー処理などは入っていません。
 名前と年齢を一つのテキストで入力したい場合は、
 追加ボタンの処理の箇所で、入力された文字列を分割して設定してください。)

'下記のコントロールをフォームに追加
リストボックスListBox1
テキストボックス(年齢)txtAge
テキストボックス(名前)txtName
ボタン(年齢順)btnSortAge
ボタン(名前順)btnSortName
ボタン(追加)btnAdd
ボタン(削除)btnDel

'------------------------------------------------------
' 下記をフォームの初期処理のコードに追加
' Form1_Load もしくは Public Sub New() の中に追加
'------------------------------------------------------

Call InitListBox()

'------------------------------------------------------
' 下記をフォームのコードに追加
'------------------------------------------------------
Dim mListBoxDtSet As DataSet
Dim mListBoxDtTable As DataTable
Dim mListBoxDtView As DataView

'リストボックス削除処理
Private Function DelListBox(ByVal index As Integer) As Boolean

Dim dtRow() As DataRow
dtRow = mListBoxDtTable.Select("Id = " & index.ToString)
If IsNothing(dtRow(0)) = False Then
mListBoxDtTable.Rows.Remove(dtRow(0))
Return True
Else
Return False
End If

End Function

'リストボックス追加処理(戻り値:追加した項目のIndex="Id")
Private Function AddListBox(ByVal age As Integer, ByVal name As String) As Integer
Dim dtRow As DataRow

dtRow = mListBoxDtTable.NewRow()
dtRow("Age") = age
dtRow("Name") = name
dtRow("DisplayCol") = name & " " & age 'リストボックスへ表示する内容
mListBoxDtTable.Rows.Add(dtRow)

Return CType(dtRow.Item("Id"), Integer)

End Function

'リストボックス初期化処理
Private Sub InitListBox()
'データセット作成
mListBoxDtSet = New DataSet("ListBoxData")
'データテーブル作成
mListBoxDtTable = mListBoxDtSet.Tables.Add("Hito")
Dim pkCol As DataColumn = mListBoxDtTable.Columns.Add("Id", Type.GetType("System.Int32"))
pkCol.AutoIncrement = True
pkCol.AutoIncrementSeed = 1
pkCol.AutoIncrementStep = 1
mListBoxDtTable.Columns.Add("DisplayCol", Type.GetType("System.String"))
mListBoxDtTable.Columns.Add("Age", Type.GetType("System.Int32"))
mListBoxDtTable.Columns.Add("Name", Type.GetType("System.String"))
mListBoxDtTable.PrimaryKey = New DataColumn() {pkCol}
'データビュー作成
mListBoxDtView = New DataView(mListBoxDtSet.Tables("Hito"), "", "", DataViewRowState.CurrentRows)
mListBoxDtView.Sort = "Id"
'リストボックスとデータビューを連結
ListBox1.DataSource = mListBoxDtView
ListBox1.DisplayMember = "DisplayCol"
ListBox1.ValueMember = "Id"

End Sub

'年齢順ボタン_クリックイベントハンドラ
Private Sub btnSortAge_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles btnSortAge.Click
'降順にしたい場合は"ASC"を"DESC"に変更
mListBoxDtView.Sort = "Age ASC"
End Sub

'名前順ボタン_クリックイベントハンドラ
Private Sub btnSortName_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles btnSortName.Click
'降順にしたい場合は"ASC"を"DESC"に変更
mListBoxDtView.Sort = "Name ASC"
End Sub

'追加ボタン_クリックイベントハンドラ
Private Sub btnAdd_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles btnAdd.Click
Call AddListBox(txtAge.Text, txtName.Text)
End Sub

'削除ボタン_クリックイベントハンドラ
Private Sub btnDel_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles btnDel.Click
'選択項目存在チェック
If ListBox1.SelectedItems.Count = 0 Then
Exit Sub
End If
'選択項目情報取得
Dim rowId(ListBox1.SelectedItems.Count - 1) As Integer
Dim dtRow As DataRowView
For i As Integer = 0 To ListBox1.SelectedItems.Count - 1
dtRow = CType(ListBox1.SelectedItems(i), DataRowView)
rowId(i) = CType(dtRow("Id"), Integer)
Next
'選択項目該当行削除
For i As Integer = 0 To ListBox1.SelectedItems.Count - 1
Call DelListBox(rowId(i))
Next
End Sub

下記のコントロールとコードを追加すると実現できます。
他にも方法はあるのですが、自作のコントロールを作る必要があるので、
この方法が簡単だと思います。
前に作っていたものを少し改造したものなのでもしかしたら不具合があるかもしれません。
(エラー処理などは入っていません。
 名前と年齢を一つのテキストで入力したい場合は、
 追加ボタンの処理の箇所で、入力された文字列を分割して設定してください。)

'下記のコントロールをフォームに追加
リストボックスListBox1
テキストボックス...続きを読む

QVBAでシートからコンボボックスにデータを設定する方法

VBAにてフォーム起動時にシート内に設定した
値をコンボボックスに取り込みたいのですが・・。
たとえばA列に連続で入力されているデータを
取り込むなど・・。
設定データ数は動的に変化します。

Aベストアンサー

もうほとんど同じですが…

Private Sub UserForm_Initialize()
Dim i As Integer

 ComboBox1.Clear
 For i = 1 To Worksheets("sheet1").Cells(Rows.Count, 1).End(xlUp).Row
  ComboBox1.AddItem Worksheets("sheet1").Cells(i, 1).Value
 Next
End Sub

Qエクセル VBA ユーザーフォームを閉じる

ユーザーフォームを開く時は
UserForm1.Showですが
閉じる時は?
UserForm1.Close
だとコンパイルエラーになります。
End
にするしかないですか?

Aベストアンサー

Unload Me とか Unload UserForm1 でユーザーフォームを閉じることができます。

QExcel VBA コンボボックスの初期値の設定について

いつもお世話になっています。
Excel VBA コンボボックスの初期値の設定について教えてください。
ユーザーフォームを表示させた時、そこにあるコンボボックスには何も表示されていません。
コンボボックスのボタンを押すとちゃんと
「アジア」「ヨーロッパ」「アメリカ」等の語群が表示されます。

ユーザーフォームを表示させた時点でコンボボックスに「アジア」を表示させるにはどうすればいいか教えてください。
よろしくお願いします。

Aベストアンサー

UserForm Initialize
ComboBox1.Text = ComboBox1.List(0)

QEXCEL VBAで計算値を四捨五入、切り上げ、切捨てする方法

ネットで探してみたのですが、計算結果を四捨五入して特定のセルを
返すにはどうしたらいいのでしょうか?

Sub hokangosa()

Dim ZPS As Double
Dim ZPOS As Double
Dim DMN As Double
MsgBox (" >>> 補間誤差自動計算 <<< ")
MsgBox (" >>> 初期値入力します <<< ")
ZPS = InputBox(">>> ステップを入力してください<<<")
ZPOS = Sheet1.Cells(22, 4).Value
DMN = ZPOS / ZPS
Sheet1.Cells(23, 6).Value = DMN
End Sub

ここでDMNの値を四捨五入したいです。

またこれとは別に切上げ、切捨ても教えていただけるとありがたいです。

Aベストアンサー

DMN = Application.WorksheetFunction.Round(ZPOS / ZPS, 0)
で、四捨五入
DMN = Application.RoundDown(ZPOS / ZPS, 0)
で切り捨て
DMN = Application.RoundUp(ZPOS / ZPS, 0)
で切り上げです。

引数で、対象桁を変更できます。

QEXCEL VBA で現在開いているブックのファイル名を取得する方法

EXCEL2003 VBAで業務を簡素化するために、現在開いているブックのファイル名を取得する方法が分かりません。
作業手順をマクロを使って処理していますが、オリジナルのワークブックをファイル名を変えて保存し、以後、このワークブックを読み込んで使用しています。
このときのVBAは、オリジナルのファイル名を使っているため、ファイル名を変更するとエラーになり、以後の業務に使用できません。
常にファイル名を取得出来るVBAをどなたか、教えて下さい。

Aベストアンサー

>現在開いているブックのファイル名
 ちょっと曖昧な表現かなぁという気もいたしますが、VBAが書いてあるブックのブック名は
ThisWorkbook.Name
で、現在 "アクティブにして" 操作対象になっているブックの名前は
ActiveWorkbook.Name
ですね。

 しかし、
>VBAは、オリジナルのファイル名を使っているため、ファイル名を変更するとエラーになり
というような文脈からすると、
ThisWorkbook.Name
の方ですかね。

Q【Excel VBA】マクロでExcel自体を終了させたい

環境:WindowsXP、Excel2003

マクロでエクセルを終了(ブックを閉じて、アプリケーション自体も終了)させたいのですが、以下のコードではアプリケーションが閉じてくれません。

ThisWorkbook.Close
ExcObj.Quit
Application.Quit

どこか悪いところはありますでしょうか?

よろしくお願いします。

Aベストアンサー

普通に考えれば質問者のコードで上手くいきそうですが
hana-hana3さんの回答にもあるようにThisWorkBook.Closeでコード終了となりますので
Application.QuitをThisWorkBook.Closeの前にもってこないといけません。
Application.Quitはそれがあるプロシージャのコードが全て終わるまで
その実行を保留するちょと特別動作をします。

'-------------------------------------
 Application.Quit
 ThisWorkbook.Close
'-------------------------------------
 
 

QVBA コンボボックスの重複削除

こんばんわ。
VBAをはじめたばかりで、コンボボックスで困っています。
sheet1にコンボボックスを配置して、sheet2のA列にあるデータ (例) A列
         1
         1
         2
を コンボボックスに
         1
         2
というようにデータを入れたいのですが、どの様にしたらよいのでしょうか?

sheet1.コンボボックス.value=workSheet("sheet2).Range(A1:A3).value とすると1・1・2というようにA列の値がすべて入ってしまいました。
これを1・2というようにコンボボックスに入れたいです。 
よろしくお願いいたします。

Aベストアンサー

こんばんは。一案です。参考にしてください。


Sub Test()
Dim R As Long
Worksheets("Sheet1").ComboBox1.Clear

With Worksheets("Sheet2")
 For R = 1 To .Range("A1").End(xlDown).Row - 1
  If .Range("A" & R) <> .Range("A" & R + 1) Then
   Worksheets("Sheet1").ComboBox1.AddItem .Range("A" & R)
  End If
 Next R
   Worksheets("Sheet1").ComboBox1.AddItem .Range("A" & R)
End With
End Sub

 
以上です。


このQ&Aを見た人がよく見るQ&A

人気Q&Aランキング