[[20151224125758]] 『ListBoxに指定列(C列→B列)順の表示方法についax(ぽぽろん) ページの最後に飛ぶ

[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]

 

『ListBoxに指定列(C列→B列)順の表示方法について』(ぽぽろん)

お世話になっております。

下記コードは、ComboBoxに表示された値に合致するものを指定列から読み取るコードです。
それを、ListBox4 と ListBox5 に値を表示させ

ListBox5 のみダブルクリックで「リストの1列目の値」を
セルに転記できるようにしております。(この部分のコードは掲載しておりません)

質問は、現在・・・

「ListBox5」について2列表示「B列→C列」の並びで表示されております。

これを「C列→B列」の並びで表示できるようにしたいと考えております。

どうか、アドバイスの程よろしくお願いします。

'-------------------------------------------------
'(ComboBox用)ComboBoxで選択したデータをリストボックスに読み込み
'-------------------------------------------------

    'Listの先頭セル位置を基準(先頭列の列見出しのセル位置)として配列に格納状態にする
    Set ColHeader = Worksheets("デモ").Range("D4:AY4")
    'コンボボックスの初期設定
    With ComboBox1
        .ColumnWidths = "30"
        .Column = ColHeader.Value
    End With

'--------------------------------------------------------------------
'(ComboBoxへリスト読み込み)
'--------------------------------------------------------------------
Private Sub ComboBox1_Change()

    Dim idx As Long
    Dim r, s, t, u As Range
    idx = ComboBox1.ListIndex
    If idx < 0 Then Exit Sub

    '★ComboBoxで表示された値を勤務表の個人名から選択する

    Dim c As Range    '検索セル(ComboBox用)
    Dim key As String    '検索値(ComboBoxに表示された値)

    If ComboBox1.ListIndex <> -1 Then
        ' 現在選択されている項目名を取得する
        key = ComboBox1.List(ComboBox1.ListIndex)

        '範囲内で
        For Each c In Range("B8:B55")
            'セル値が部分一致した場合
            If c.Value Like "*" & key Then
                'そのセルを選択
                c.Select
            End If
        Next

    End If

    '★※ColHeaderで取得したComboBox値に対応するセル番地を取得

    Set r = ColHeader.Item(idx + 1)    'BOX表示のセル番地(+1 直下/0(空白) 左セル)
    Set t = ColHeader.Item(idx)    'BOX表示のセル番地の左セル
    Set u = r.Offset(-1)    'rの上のセル値を格納(ワークシート関数の数値を取得)
    '表示列の最終行+1セル行値取得したものをB列&最終行として取得
    Set s = r.End(xlDown).Offset(1).EntireRow.Range("B1")

    '★ListBox4へリスト読込(2列)

省略

    '★ListBox5へリスト読込(2列)

    'セルs:C列の30行目までを格納
    Set s = s.Resize(30, 3)
    'ListBox5にr値を代入し日付け形式ををテキストに変換表示
    ListBox5.List = Application.Text(s, "gee.mm.dd(aaa);;")

省略

End Sub

< 使用 Excel:Excel2010、使用 OS:Windows7 >


 正攻法(?)としては、コード内でB列とC列をいれかえた配列を生成してそれを List に格納するということが考えられますが
 1つの方法として、サンプルです。

    Dim colB As Range
    Set colB = Range("B1", Range("B" & Rows.Count).End(xlUp))
    ListBox5.List = Evaluate("IF({TRUE,FALSE}," & colB.Offset(, 1).Address & "," & colB.Address & ")")

 ★Evaluateで列を入れ替えた配列を生成していますが、学校内の

[[20070427203222]] 『不思議なVLOOKUP』(代奈)

 で紹介された数式をパクっています。

(β) 2015/12/24(木) 14:23


 ↑ あっ!

 リストはB,Cの2列ではなく、A,B,Cの3列で、その中の2列目と3れつ目を入れ替えたいということでしたか?

(β) 2015/12/24(木) 14:28


 A〜Cの3列を、B,C入れ替えてセットするサンプルです。

    Dim v As Variant
    v = Range("A1", Range("A" & Rows.Count).End(xlUp)).Resize(, 3)
    ListBox5.List = Application.Text(Application.Index(v, Evaluate("row(1:" & UBound(v, 1) & ")"), Array(1, 3, 2)), "gee.mm.dd(aaa);;")

 配列内の列入れ替えは、seiyaさんが、よく紹介される数式をパクッています。

(β) 2015/12/24(木) 15:23


βさん

早速ありがとうございます。
実際に下記のように差替えて試してみました。

ListBox5.List Evaluate の「List」の部分でプロパティの使い方が不正ですと表示されました。

ちなみに、ListBoxに読み込む列は「CとB」です。

(補足ですが、処理の流れについては下記のような感じの処理を行っております)

・"D4:AY4"の範囲の列セルの値をComboBoxに読込んで表示された列の値を元に
・ListBoxへ「C列とB列」にあるデータ範囲を読み込みます。

(アドバイスのコードを差替えた部分です)

    '★ListBox5へリスト読込(2列)

    'セルs:C列の30行目までを格納
    Set s = s.Resize(30, 3)

'★-ここ---'ListBox5にr値を代入し日付け形式ををテキストに変換表示

    ListBox5.List Evaluate("IF({TRUE,FALSE}," & s.Offset(, 1).Address & "," & s.Address & ")") 

    'TextBox4にuに格納したセル値を表示
    TextBox4.Value = "当月残休 " & u & " 日"
(ぽぽろん) 2015/12/24(木) 18:25

 先にアップしたコードは 2列領域のセット。
 後にアップしたものが3列領域のセットです。

 Set s = s.Resize(30, 3) ですから、s は3列領域なんですよね??

 仮に2列を逆にしてセットするような要件の場合は先にアップした構文になりますが、
 それでも、コードを見ていただいてわかるとおり、colB は1列の領域ですよ。

(β) 2015/12/24(木) 18:58


βさん

ありがとうございます。
下記の方法で、読み込みができました。

    '★ListBox5へリスト読込

    'セルs:C列の30行目までを格納
    Set s = s.Resize(30, 1)
    'sの値をB列-C列の並びをEvaluate〜でC列-B列に入れ替える
    'ListBox5にr値を代入し日付け形式ををテキストに変換表示
    ListBox5.List = Application.Text(Evaluate("IF({TRUE,FALSE}," & s.Offset(, 1).Address & "," & s.Address & ")"), "gee.mm.dd(aaa);;")

あとは、入れ替えた分をダブルクリックで入力する際に
リストボックスの1列目をセルに転記していたのを
リストボックスの2列目をセルに転記できるか試してみます。

(ぽぽろん) 2015/12/24(木) 23:56


βさん

リストボックスに読み込むシートを表示させてフォームを立ち上げると正常に表示されましたが

別のシートでフォームを立ち上げて実行しますが読み込みませんでした。

UserForm_Initializeで

    'Listの先頭セル位置を基準(先頭列の列見出しのセル位置)として配列に格納状態にする
    Set ColHeader = Worksheets("デモシート").Range("D4:I4")

Private Sub ComboBox1_Change()内の・・・

Set r = ColHeader.Item(idx + 1) 'BOX表示のセル番地(+1 直下/0(空白) 左セル)

で読み込んでいる値が・・・

表示列を入れ替える際に表示中のシート内の値を読み込むようになってしまっているようです(たぶん^^;)

    ListBox5.List = Application.Text(Evaluate("IF({TRUE,FALSE}," & s.Offset(, 1).Address & "," & s.Address & ")"), "gee.mm.dd(aaa);;")

シート構成がわかりにくい状況で申し訳ありませんが
引き続きアドバイスをお願いします。

(ぽぽろん) 2015/12/25(金) 00:10


 >>表示列を入れ替える際に表示中のシート内の値を読み込むようになってしまっているようです

 状況依存のコードになっているんだと思われます。
 たとえば変数 s をセットしているプロシジャのコードをアップしてもらえますか。

(β) 2015/12/25(金) 08:52


βさん

ご迷惑をおかけしております。

下記が、変数sをセットしているためのコード1式です。

Option Explicit
'/////////////////////////////////////////////////////////////////////
'ComboBox1リスト選択でデータを参照させる変数
'処理中にメモリを解放しないこと

Private ColHeader As Range

'-------------------------------------------------
'(ComboBox用)ComboBoxで選択したデータをリストボックスに読み込み
'-------------------------------------------------
Private Sub UserForm_Initialize()

    'Listの先頭セル位置を基準(先頭列の列見出しのセル位置)として配列に格納状態にする
    Set ColHeader = Worksheets("デモシート").Range("D4:I4")
    'コンボボックスの初期設定
    With ComboBox1
        .ColumnWidths = "30"
        .Column = ColHeader.Value
    End With

End Sub

'--------------------------------------------------------------------
'(ComboBoxへリスト読み込み)
'--------------------------------------------------------------------
Private Sub ComboBox1_Change()

    Dim idx As Long
    Dim r, s, t, u As Range
    idx = ComboBox1.ListIndex
    If idx < 0 Then Exit Sub

    '★ComboBoxで表示された値を勤務表の個人名から選択する

    Dim c As Range    '検索セル(ComboBox用)
    Dim key As String    '検索値(ComboBoxに表示された値)

    If ComboBox1.ListIndex <> -1 Then
        ' 現在選択されている項目名を取得する
        key = ComboBox1.List(ComboBox1.ListIndex)

        '範囲内で
        For Each c In Range("B8:B55")
            'セル値が部分一致した場合
            If c.Value Like "*" & key Then
                'そのセルを選択
                c.Select
            End If
        Next

    End If

    '★※ColHeaderで取得したComboBox値に対応するセル番地を取得

    Set r = ColHeader.Item(idx + 1)    'BOX表示のセル番地(+1 直下/0(空白) 左セル)
    Set t = ColHeader.Item(idx)    'BOX表示のセル番地の左セル
    Set u = r.Offset(-1)    'rの上のセル値を格納(ワークシート関数の数値を取得)
    '表示列の最終行+1セル行値取得したものをB列&最終行として取得
    Set s = r.End(xlDown).Offset(1).EntireRow.Range("B1")

    '★ListBox4へリスト読込(2列)C列→B列の順にする

    'ComboBox表示セル列:前列の最終行範囲の値を格納
    Set t = Excel.Range(t.Offset(1), r.End(xlDown))
    'ListBox4にt:r値代入し日付形式をText変換(空白は;;で空白表示)
    ListBox4.List = Application.Text(t, "gee.mm.dd(aaa);;")
    '表示データは常に最下行を表示する
    ListBox4.ListIndex = ListBox4.ListCount - 1

    '★ListBox5へリスト読込(2列)

    'セルs:C列の30行目までを格納
    Set s = s.Resize(30, 3)
    'ListBox5にr値を代入し日付け形式ををテキストに変換表示
    ListBox5.List Evaluate("IF({TRUE,FALSE}," & s.Offset(, 1).Address & "," & s.Address & ")") '= Application.Text(s, "gee.mm.dd(aaa);;")
    'TextBox4にuに格納したセル値を表示
    TextBox4.Value = "当月残休 " & u & " 日"

End Sub

(ぽぽろん) 2015/12/25(金) 13:13


 一式アップされたコードをざっと眺めました。

 >>ListBox5.List Evaluate("IF({TRUE,FALSE}," & s.Offset(, 1).Address & "," & s.Address & ")") '= Application.Text(s, "gee.mm.dd(aaa);;")

 これってコンパイルエラーの時のままですね?
 s の領域も3列のままです。

 今は、このコードではないと思います。
 現在のコードをアップしてください。

 それと・・・

        '範囲内で
        For Each c In Range("B8:B55")
            'セル値が部分一致した場合
            If c.Value Like "*" & key Then
                'そのセルを選択
                c.Select
            End If
        Next

 ここは何をしているのですか? keyとマッチしたセルを c.Select これをループさせていますので
 最後にマッチしたセルが選択されますけど、その選択されたセルを、このプロシジャの後続のステップで
 まったく参照していないのですが?

 また、対象領域が Range("B8:B55") ですから、「今、たまたまアクティブになっているシート」を検索しています。
 これでいいのですか?

(β) 2015/12/25(金) 13:45


 それと・・・

 >> '★ListBox4へリスト読込(2列)C列→B列の順にする

 C列、B列の表示にしたかったのは ListBox4 だったんですか?
 私がアップしたコードは ListBox5 を相手にしていますよ?

 さらに、ListBox4 が対象なら現在のそちらのコードでは 領域 t をセットしていますが
 t は マッチした列と、その前の列ですよね? B、Cじゃないですよね?

(β) 2015/12/25(金) 17:12


βさんすみません

ListBox5を相手にして大丈夫です。
 ↓

誤)ListBox4

正)ListBox5
(ぽぽろん) 2015/12/25(金) 17:54


 で、お願いしている、現在の最新のそちらのコードのアップ、よろしく。

 あわせて (β) 2015/12/25(金) 13:45 でコメントした疑問に対してレスお願いしますね。

(β) 2015/12/25(金) 19:03


 あっ! わかりました。

 ListBox5.List = Evaluate("IF({TRUE,FALSE}," & s.Offset(, 1).Address & "," & s.Address & ")") '= Application.Text(s, "gee.mm.dd(aaa);;")

 この中の

 s.Offset(, 1).Address  を s.Offset(, 1).Address(External:=True) に

 s.Address  を s.Address(External:=True) に

 それぞれ変更して試してみてください。

(β) 2015/12/25(金) 19:30


m(_ _)mm(_ _)mm(_ _)m βさん・・・お詫びですm(_ _)mm(_ _)mm(_ _)m

 >>それと・・・

        '範囲内で
        For Each c In Range("B8:B55")
            'セル値が部分一致した場合
            If c.Value Like "*" & key Then
                'そのセルを選択
                c.Select
            End If
        Next

すみません

この部分は「ComboBoxで選択された項目列のデータ」と「B列のデータ」を照合し
一致していなければ、着色と何かを検討段階のもので、このマクロとは切り分けて別途で対処するコードを作成中でした。

うっかりです。
このコードがないとComboBoxからListBoxに読み込めないと思い込んでいました。
すみません。ご指摘していただいて本当に助かります。なので、下記のコードから削除しました。

下記コードは、βさんにアドバイスをいただいたコードを元に変更したものです。

※この部分です。

 ListBox5.List = _
    Application.Text(Evaluate("IF({TRUE,FALSE}," & s.Offset(, 1).Address & "," & s.Address & ")"), "gee.mm.dd(aaa);;")

コンパイルエラーが出ていない分です。ただ、読み込みたいListのあるシートをアクティブにした状態でないとListBoxにデータがよみこめません。

'--------------------------------------------------------------------
'(ComboBoxへリスト読み込み)
'--------------------------------------------------------------------
Private Sub ComboBox1_Change()

    Dim idx As Long
    Dim r, s, t, u As Range
    idx = ComboBox1.ListIndex
    If idx < 0 Then Exit Sub

'★※ColHeaderで取得したComboBox値に対応するセル番地を取得

    Set r = ColHeader.Item(idx + 1)    'BOX表示のセル番地(+1 直下/0(空白) 左セル)
    Set t = ColHeader.Item(idx)    'BOX表示のセル番地の左セル
    Set u = r.Offset(-1)    'rの上のセル値を格納(ワークシート関数の数値を取得)
    '表示列の最終行+1セル行値取得したものをB列&最終行として取得
    Set s = r.End(xlDown).Offset(1).EntireRow.Range("B1")

'★ListBox4へリスト読込(2列)

    'ComboBox表示セル列:前列の最終行範囲の値を格納
    Set t = Excel.Range(t.Offset(1), r.End(xlDown))
    'ListBox4にt:r値代入し日付形式をText変換(空白は;;で空白表示)
    ListBox4.List = Application.Text(t, "gee.mm.dd(aaa);;")
    '表示データは常に最下行を表示する
    ListBox4.ListIndex = ListBox4.ListCount - 1

'★ListBox5へリスト読込(2列)&列の入れ替え

    'セルs:C列の30行目までを格納
    Set s = s.Resize(30, 1)

'【作業中】sの値をB列-C列の並びをEvaluate〜でC列-B列に入れ替える

    'ListBox5にr値を代入し日付け形式ををテキストに変換表示
    ListBox5.List = _
    Application.Text(Evaluate("IF({TRUE,FALSE}," & s.Offset(, 1).Address & "," & s.Address & ")"), _
    "gee.mm.dd(aaa);;")

'★TextBox4へセル値表示

    'TextBox4にuに格納したセル値を表示
    TextBox4.Value = "当月残休 " & u & " 日"

End Sub
(ぽぽろん) 2015/12/25(金) 19:32


 いえいえ、こちらこそ、ごめんなさいなんです。

 (β) 2015/12/25(金) 19:30 で修正連絡しましたが、まさしく、β自身が【状況依存コード】を書いていました。

(β) 2015/12/25(金) 19:35


βさん

コメントの衝突でなかなかアップできませんでしたが・・・

最新のコメントで無事動きました。

どのシートでも、ComboBoxに表示されたシートのデータが読み込めています。

ちょっと、色々試してみます。
(ぽぽろん) 2015/12/25(金) 19:36


βさん

コードまったくもって問題なく動いていることが確認できました。

最後に、もう一つお願いしてもよろしいでしょうか?

それと・・・
        '範囲内で
        For Each c In Range("B8:B55")
            'セル値が部分一致した場合
            If c.Value Like "*" & key Then
                'そのセルを選択
                c.Select
            End If
        Next

の部分ですが、これを今のコードに組み込んでみようと思いました。

処理の流れですが
フォームを起動させる際に、勤務表Sheetを表示してからの作業になります。

・ComboBoxで選択した項目名(個人名)が

・勤務表シートのB列にある個人名と一致した場合

・B列の個人名セルを選択
・ListBox4、ListBox5にデータセット(解決済みのコード)

一致しなかった場合は

・「該当者なし。確認してください」のコメント表示して
・ListBox4、ListBox5にデータをセットしない(解決済みのコード)

実際に For Each Next でやってみましたが
B列の指定範囲ループして該当する値が見つかるまでループ&コメント表示されてしまいます。

・該当する値が見つかったらループ終了
・該当値がない場合のみコメント表示して終了

したいのですが、至らず初歩的なミスかなぁと思いますがよろしくお願いいたします。

Private Sub ComboBox1_Change()

    Dim idx As Long
    Dim r, s, t, u As Range
    idx = ComboBox1.ListIndex
    If idx < 0 Then Exit Sub

'★ComboBoxで選択した氏名を勤務表のB列の氏名と一致すればSelectする

    Dim c As Range    '検索セル(ComboBox用)
    Dim key As String    '検索値(ComboBoxに表示された値)

    If ComboBox1.ListIndex <> -1 Then
        ' 現在選択されている氏名を取得する
        key = ComboBox1.List(ComboBox1.ListIndex)
        '勤務表の氏名があるB列指定範囲内で
        For Each c In Range("B8:B55")
            'ComboBoxの選択値とセル値が部分一致した場合
            If c.Value Like "*" & key Then

'★一致した場合(その氏名のあるセルを選択)

                c.Select

'★ColHeaderで取得したComboBox値に対応するセル番地を取得
(コード省略)
'★ListBox4へリスト読込(2列)
(コード省略)
'★ListBox5へリスト読込(2列)&列の入れ替え
(コード省略)
'★TextBox4へセル値表示

'★一致しなかった場合(個人名が一致しなかった場合)

            Else '条件が一致しない場合は終了
                MsgBox "該当者なし。確認してください"
            End If
        Next
    End If
End Sub

(ぽぽろん) 2015/12/26(土) 14:06


 今までの一連のトピを追いかければ、シート構成やレイアウトも把握できるのかもしれませんが、 
 年よりなので、そこまでの気力が、なかなかわきません。

 で、今回のトピのみで考えると、

 ・ComboBoxで選択した項目名(個人名)が 
 ↓ 
 ・勤務表シートのB列にある個人名と一致した場合 
 ↓ 
 ・B列の個人名セルを選択 
 ・ListBox4、ListBox5にデータセット(解決済みのコード) 

 コードを読む限り、ComboBox1 のリストは 「デモシート」の D4:I4 の内容であり
 ComboBox1 で選ばれたものについては、「勤務表シートのB列にある個人名と一致した場合 」というロジックにはなっておらず
 「デモシート」上の、B:C列の、選択された項目がある列のデータ最終行の次の行から30行の範囲を(B,Cいれかえて)
 ListBox5 にセットしていますよね。

 つまり、↑で説明された流れにはなっていないんです。

 まぁ、コードとつきあわせれば、問題が浮かび上がるかもしれませんが、いかんせん【省略】されています。

 フルセットのコードアップはできないでしょうか?

(β) 2015/12/26(土) 18:30


 最終的に、ListBox4 と ListBox5 には、どのシートのどういった領域からセットしたいかも説明願います。
 コメントしたように、現在のコードは 「デモシート」上の領域をセットしていますので。

(β) 2015/12/26(土) 18:38


βさん
説明不足ですみません。

For Each c In Range("B8:B55")の部分はアクティブシートを対象としており

ComboBoxの値(Worksheets("デモシート"))と比較します。

アドバイスいただいたListBox4・5へのデータ読み込みはWorksheets("デモシート")から読み込めるように修正していただけたので、問題なく動いております。

現在作業中のコードは下記です。

'--------------------------------------------------------------------
'(ComboBoxへリスト読み込み)
'--------------------------------------------------------------------
Private Sub ComboBox1_Change()

    Dim idx As Long
    Dim r, s, t, u As Range
    idx = ComboBox1.ListIndex
    If idx < 0 Then Exit Sub

'ComboBoxで選択した氏名を勤務表のB列の氏名と一致すればSelectする

    Dim c As Range    '検索セル(ComboBox用)
    Dim key As String    '検索値(ComboBoxに表示された値)

    If ComboBox1.ListIndex <> -1 Then
        ' 現在選択されている氏名を取得する
        key = ComboBox1.List(ComboBox1.ListIndex)
        '勤務表の氏名があるB列指定範囲内で
        For Each c In Range("B8:B55")
            'ComboBoxの選択値とセル値が部分一致した場合
            If c.Value Like "*" & key Then

'★条件が一致した場合の処理

                'その氏名のあるセルを選択
                c.Select

'※ColHeaderで取得したComboBox値に対応するセル番地を取得

    Set r = ColHeader.Item(idx + 1)    'BOX表示のセル番地(+1 直下/0(空白) 左セル)
    Set t = ColHeader.Item(idx)    'BOX表示のセル番地の左セル
    Set u = r.Offset(-1)    'rの上のセル値を格納(ワークシート関数の数値を取得)
    '表示列の最終行+1セル行値取得したものをB列&最終行として取得
    Set s = r.End(xlDown).Offset(1).EntireRow.Range("B1")

'ListBox4へリスト読込(2列)

    'ComboBox表示セル列:前列の最終行範囲の値を格納
    Set t = Excel.Range(t.Offset(1), r.End(xlDown))
    'ListBox4にt:r値代入し日付形式をText変換(空白は;;で空白表示)
    ListBox4.List = Application.Text(t, "gee.mm.dd(aaa);;")
    '表示データは常に最下行を表示する
    ListBox4.ListIndex = ListBox4.ListCount - 1

'ListBox5へリスト読込(2列)&列の入れ替え

    'セルs:C列の30行目までを格納
    Set s = s.Resize(30, 1)

'sの値をB列-C列の並びをEvaluate〜でC列-B列に入れ替える

    'ListBox5にr値を代入し日付け形式ををテキストに変換表示
    ListBox5.List = _
    Application.Text(Evaluate("IF({TRUE,FALSE}," & s.Offset(, 1).Address(External:=True) & "," & s.Address(External:=True) & ")"), _
    "gee.mm.dd(aaa);;")
    '表示データは常に最下行を表示する
    ListBox5.ListIndex = 0

'TextBox4へセル値表示

    'TextBox4にuに格納したセル値を表示
    TextBox4.Value = "当月残休 " & u & " 日"

'★条件が一致していない場合の処理

            Else '条件が一致しない場合は終了
                MsgBox "該当者なし。確認してください"
            End If
        Next
    End If

End Sub

(ぽぽろん) 2015/12/26(土) 21:06


 コード拝見。
 こちらから最終的な処理案フルセットコードをアップするのはしばらく控えましょう。
 現在のそちらのコードの、ループ処理部分の余分なコメントを削除し、インデントを付けて記述したものが以下です。

 これを見ると、セルごとに条件に一致しなければメッセージを出して次のセルのチェックに移っていることがわかりますね。
 これを

 有り無しフラッグをFalse にして
 For Each c In ・・・
    If ・・・ なら
    有り無しフラッグ = True
        Exit For
    End If
 Next

 If Not 有り無しフラッグ Then
    MsgBox 
 Else
    ListBox4とListBox5 へのセット
 End If

 こんな構えにすればいいということがわかると思います。

 ★現在のコード

        For Each c In Range("B8:B55")
            If c.Value Like "*" & key Then
                c.Select
                Set r = ColHeader.Item(idx + 1)    'BOX表示のセル番地(+1 直下/0(空白) 左セル)
                Set t = ColHeader.Item(idx)    'BOX表示のセル番地の左セル
                Set u = r.Offset(-1)    'rの上のセル値を格納(ワークシート関数の数値を取得)
                Set s = r.End(xlDown).Offset(1).EntireRow.Range("B1")
                Set t = Excel.Range(t.Offset(1), r.End(xlDown))
                ListBox4.List = Application.Text(t, "gee.mm.dd(aaa);;")
                ListBox4.ListIndex = ListBox4.ListCount - 1
                Set s = s.Resize(30, 1)
                ListBox5.List = _
                    Application.Text(Evaluate("IF({TRUE,FALSE}," & s.Offset(, 1).Address(External:=True) & "," & s.Address(External:=True) & ")"), _
                            "gee.mm.dd(aaa);;")
                ListBox5.ListIndex = 0
                TextBox4.Value = "当月残休 " & u & " 日"
            Else '条件が一致しない場合は終了
                MsgBox "該当者なし。確認してください"
            End If
        Next

(β) 2015/12/26(土) 21:43


 横からすみませーん。

 この方が少し簡明かなと思いまして・・・、些細な事なので無視して頂いて構いません。

 ListBox5.List = _
   Application.Text(Application.Choose([{2,1}], s, s.Offset(, 1)), "gee.mm.dd(aaa);;")

(半平太) 2015/12/26(土) 23:53


 To 半平太さん

[[20070427203222]] 『不思議なVLOOKUP』(代奈) 

 このトピでも VLOOKUP に加えて CHOOSE の提示もありましたね。
 VLOOKUPにしろ、CHOOSE にしろ、実際にやってみてそうなるということは確認しているのですが
 なぜ、こんなことができるのかについては、まったく、わかっていません。
 いずれも、βにとっては「不思議」な世界です。

(β) 2015/12/27(日) 00:27


 To ぽぽろん さん

 対応案として

 有り無しフラッグをFalse にして
 For Each c In ・・・
    If ・・・ なら
    有り無しフラッグ = True
        Exit For
    End If
 Next

 If Not 有り無しフラッグ Then
    MsgBox 
 Else
    ListBox4とListBox5 へのセット
 End If

 と提示しましたが、For Each c In 処理で、最後まで見つからずにループを終了すると c が Nothing になっている特性を利用して

 For Each c In ・・・
    If ・・・ なら Exit For
 Next

 If c Is Nothing Then
    MsgBox 
 Else
    ListBox4とListBox5 へのセット
 End If

 こんなコードでもいいですね。

(β) 2015/12/27(日) 00:36


【解決です。\(^o^)/】

半平太さん

シンプルなコードありがとうございます。
実装させていただきました。問題なく動いております。

βさん

ありがとうございます。

アドバイスいただいたコードで無事動くようになりました。
長いことご指導いただき感謝でいっぱいです。

ようやく次のステージに移れます。
年内にはなんとか完成させたいと思います。

今後ともよろしくお願いします。

Private Sub ComboBox1_Change()

    Dim idx As Long
    Dim r, s, t, u As Range
    idx = ComboBox1.ListIndex
    If idx < 0 Then Exit Sub
    Dim c As Range    '検索セル(ComboBox用)
    Dim key As String    '検索値(ComboBoxに表示された値)

    If ComboBox1.ListIndex <> -1 Then
        key = ComboBox1.List(ComboBox1.ListIndex)

        For Each c In Range("B8:B55")
            If c.Value Like "*" & key Then Exit For
        Next

        If c Is Nothing Then    '該当しない場合

            '前のデータが残っているかもしれないのでListBoxの値をclearする
            ListBox4.Clear
            ListBox5.Clear
            MsgBox "該当者なし。確認してください"

        Else    '該当する場合

            c.Select

            Set r = ColHeader.Item(idx + 1)    'BOX表示のセル番地(+1 直下/0(空白) 左セル)
            Set t = ColHeader.Item(idx)    'BOX表示のセル番地の左セル
            Set u = r.Offset(-1)    'rの上のセル値を格納(ワークシート関数の数値を取得)
            Set s = r.End(xlDown).Offset(1).EntireRow.Range("B1")
            Set t = Excel.Range(t.Offset(1), r.End(xlDown))
            ListBox4.List = Application.Text(t, "gee.mm.dd(aaa);;")
            ListBox4.ListIndex = ListBox4.ListCount - 1
            Set s = s.Resize(30, 1)
            ListBox5.List = Application.Text(Application.Choose([{2,1}], s, s.Offset(, 1)), "gee.mm.dd(aaa);;")
            ListBox5.ListIndex = 0
            TextBox4.Value = "当月残休 " & u & " 日"
        End If
    End If
End Sub
(ぽぽろん) 2015/12/27(日) 08:23

コメント返信:

[ 一覧(最新更新順) ]


YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki. Modified by kazu.