エクセルのリストボックに見出しをつける方法

このQ&Aのポイント
  • エクセルのリストボックスに見出しをつける方法について教えてください。
  • UserForm_Initialize()関数内でリストボックスに値を表示する際に、見出しの表示方法について質問があります。
  • 変数に格納されている1行目の値をリストボックスの見出しとして使用する方法はありますか?
回答を見る
  • ベストアンサー

エクセルのリストボックに見出しをつけたい

あるシートから条件を絞って変数に格納し、リストボックスに表示するプログラムを作っているのですがリストボックスの見出しの付け方がわかりません。 Private Sub UserForm_Initialize() Dim i As Long 'シートHDに 変数HDを格納する Sheets("HD").Select HD = Range(Cells(1, 1), cells(10000,1))) 'myDataにリストボックに入れたい値を入れる Dim myData() As Variant ReDim myData(9, 0 To 1000) j = 1   k = 0 While HD(j, 1) <> "" ReDim Preserve myData(1, k) If HD(j,1)>10 then myData(0, k) = HD(j, 1) myData(1, k) = HD(j, 2) k=k+1 End If j = j + 1 Wend With ListBoxHD .ColumnCount = -1 .ColumnWidths = "30;100" .ColumnHeads = True .Column() = myData End With End Sub こうすると見出しのような枠はでるのですが、空白になってしまいます。 .Column() = myData を .RowSource = myData に変えたらエラーになってしまいました。 回避策としてリストボックスに入れたいデータをEXCELの別のシートに一旦書き込んでそれを読み込むという方法はあるのですが、 書き込むこと自体に時間がかかるのでそれは避けたいです。 単純に変数に入っている1行目を見出しに使いたいというだけなのですが、方法はないのでしょうか?

  • kikei
  • お礼率70% (82/116)

質問者が選んだベストアンサー

  • ベストアンサー
  • kybo
  • ベストアンサー率53% (349/647)
回答No.1

見出しは意図的に設定できず、RowSourceを設定した場合1行目が見出しとして表示されます。 RowSourceにはアドレスしか指定できません。 ListViewコントロールを使ってはどうでしょうか? http://www.officetanaka.net/excel/vba/listview/index.htm

kikei
質問者

お礼

回答ありがとうございます。 このプログラムは多数の人が使うので外部コントロールのような 別途ダウンロードが必要な方法をとることは難しいです。 EXCELの標準機能で解決する方法はないでしょうか。

関連するQ&A

  • ListBoxで表示されたデータの取得方法は

    お世話になります。 標準フォーム から以下のリストボックスを表示して、無事シートの一覧が表示されています。 Private Sub UserForm_Initialize() Dim lastRow As Long Dim myData Worksheets("Sheet1").Range("a1:C35").Value = "" With Worksheets(Sheet) myData = .Range(.Cells(1, 1), .Cells(Rows.Count, 3).End(xlUp)).Value End With With ListBox1 .ColumnCount = 3 .ColumnWidths = "20;70;100" .List = myData End With End Sub このリストボックスにはボタンが二つありボタン1を押したときに標準フォームへ[hinban] という変数にリストボックスでフォーカスしているデータを取り込みたいのですが以下の方法でうまくいきません。 Private Sub CommandButton1_Click() Dim lastRow As Long Dim i As Integer hinban = ListBox1.Column(pvargColumn:=1) End Sub もう一つのボタンは何もせずにリストボックスを閉じたいのですがこれで問題ないですか。 Private Sub CommandButton2_Click() Unload Me End Sub プログラム初心者でインターネットから寄せ集めのプログラムです。 どなたかお力をお貸しください。

  • リストボックスから値取得時のエラー

    いつも助けていただきありがとうございます。 現在、ユーザーフォームを利用し一覧から検索し検索し、希望する事業所、氏名を、double clickで2ページ目に表示し、選択した様式に事業所名(A2)、氏名(B2)、作成日(A3)へを貼り付けたいとかんがえています。 一覧から事業所検索までは上手くいくのですが、事業所名、氏名、作成日を2ページ目に表示の際、型が一致しませんとでてエラーが出てしまう状態です。色々と検索、見直しなどしたのですがどうしても修正が聞かないので皆さんの知識をお借りしたいと思い質問させていただきます。 皆さんよろしくお願いします。 ※2ページ目表示でエラーがでて先に進めていないので、選択様式へ希望するCellへの書き出しについてはまだコードは作成していません。 Cellへの書き出しは問題なく出来ると思うのですが、希望する様式を選択する際のコードのアドバイスなども一緒に教えていただければ嬉しいです。 よろしくお願いします。 Private Sub 検索ボタン_Click() '検索を実行します。部分一致検索。 Dim lastrow As Long Dim myData, myData2() Dim i As Long, cn As Long '検索対象がない場合の警告 If 氏名検索テキストボックス.Text = "" Then MsgBox "検索対象を入力してください。" Exit Sub End If '検索するデータを配列 myData に格納。 With Worksheets("名簿一覧") myData = .Range(.Cells(1, 4), .Cells(Rows.Count, 1).End(xlUp)).Value lastrow = .Cells(Rows.Count, 1).End(xlUp).Row End With '配列 myData の中で検索で一致したデータを配列 myData2 に格納。 ReDim myData2(1 To lastrow, 1 To 4) For i = LBound(myData) To UBound(myData) If myData(i, 2) Like "*" & 氏名検索テキストボックス.Value & "*" Then cn = cn + 1 myData2(cn, 1) = myData(i, 2) myData2(cn, 2) = myData(i, 3) myData2(cn, 3) = myData(i, 4) End If Next i '検索で一致したデータをリストボックスに表示。 With 検索表示リストボックス .ColumnCount = 4 .ColumnWidths = "70;70;70" .List = myData2 If .List(0, 1) = "" Then MsgBox "該当者がいません" End If End With End Sub 'ダブルクリックでセルを選択 Private Sub 検索表示リストボックス_DblClick(ByVal Cancel As MSForms.ReturnBoolean) With Worksheets("名簿一覧") .Range(.Cells(検索表示リストボックス.List(検索表示リストボックス.ListIndex, 0) + 1, 1), .Cells(検索表示リストボックス.List(検索表示リストボックス.ListIndex, 0) + 1, 4)).Select End With '選択したリストのデータ参照 Dim 行番号 As Integer 行番号 = ActiveCell.Row 作成日ラベル.Caption = Format(Date, "yyyymmdd") 氏名.Text = Cells(行番号, 2) 会社名.Text = Cells(行番号, 3) MultiPage1.Value = 1 End Sub

  • ExcelVBAについて

    以上~以下検索についてです。 現在、1文字以上一致で検索し、listboxに検索結果を表示させることができます コードは下記 Private Sub CommandButton1_Click() Dim lastRow As Long Dim myData, myData2(), myno Dim i As Long, j As Long, cn As Long With Workbooks("Master.xlsm").Worksheets("Sheet1") myData = .Range(.Cells(3, 2), .Cells(Rows.Count, 5).End(xlUp)).Value lastRow = .Cells(Rows.Count, 2).End(xlUp).Row End With ReDim myData2(1 To lastRow, 1 To 4) For i = LBound(myData) To UBound(myData) If myData(i, 2) Like "*" & TextBox2.Value & "*" And _ myData(i, 3) Like "*" & TextBox3.Value & "*" And _ myData(i, 4) Like "*" & TextBox4.Value & "*" _ Then cn = cn + 1 myData2(cn, 1) = myData(i, 1) myData2(cn, 2) = myData(i, 2) myData2(cn, 3) = myData(i, 3) myData2(cn, 4) = myData(i, 4) End If Next i If cn = 0 Then MsgBox "検索結果は見つかりませんでした・・・" Else End If With ListBox1 .ColumnCount = 4 .ColumnWidths = "20;40;20;60" End With End Sub そして今回教えていただきたいのが userfoamで 例えば,金額が1000~100000の間のものを検索し、 それに該当するものすべてをリストボックスに表示させることです。 このコードに以上~以下検索を追加するにはどうすればいいでしょうか? 新しい方法、これよりいい方法があればお教えください。 よろしくお願いいたします。

  • リストボックスの列見出し(ExcelのVBA)

     ExcelのVBAでのリストボックスコントロールについての質問です。  リストボックスの列見出しを作りたいのですが、なかなか上手く行きません。リストボックスに項目を設定するのはExcelのシートから… ----- WorkSheets("Sheet1").ListBox1.ListFillRange = "A1:B2"  ↑(Sheet1のA1:B2のデータをListBox1に追加する場合)↑ ----- のようにするのではなく… ----- Dim MyList(1,1) ~~~(MyList配列にデータを代入) Userform1.ListBox1.Column = Mylist() -----  というように、コードから項目を追加しています。  そこで、列見出しを追加したいと思ったのですが… ----- ListBox1.ColumnHeads = True ----- と記述しても、列見出しは真っ白で、その下に項目が表示されるだけです。  列見出し専用の配列を用意しなければならないというような事はあるのでしょうか?  もしあれば、どのように定義すればよいのでしょうか。  ちなみに、用いているExcelの環境は『Microsoft Excel 2004 for Mac (11.5.6)』、VBAの環境は『Microsoft Visual Basic (11.5)』です。  我流で覚えてきたような知識ですので、とても常識的な事を聞いているかもしれないですが、回答宜しくお願いします。

  • エクセルの勤務表(マクロ)についての質問です。

    エクセルの勤務表から、日付別に出勤者とその出勤者の勤務を抜き出すマクロを作りたいのですが、途中で分からなくなってしまい困っています。 初めまして。私はマクロを初めてまだ、2ヶ月の初心者でございます。 質問内容に、不手際がありましたら、ご容赦ください。 勤務表マスタには勤務表があり、それ以外にsheet1 からsheet30まで、30枚のシートを用意しておき、日付別にsheet1に4月1日の勤務者とその出勤者の勤務を(早番はB3から下に表示し、遅番はB8下に表示するようにします。)抜き出し、同じようにしてsheet2には、4月2日の勤務者とその出勤者の勤務を、同じように、それぞれB3とB8に抜き出し…というように、30日分抜きだしたいのです。休みの人は表示しません(画像写真を参照願います。見にくい写真で恐縮でございます。) <勤務表マスタ> 名前 4月1日 4月2日 4月3日 4月4日… 坂本 遅番 早番 遅番 休み… 井端 早番 休み 早番 遅番… 長野 遅番 早番 早番 早番… 阿部 遅番 遅番 遅番 早番… 村田 休み 早番 遅番 遅番… 高橋 早番 遅番 休み 遅番… <sheet1=4月1日> (B3、C3から下に) 井端 早番 高橋 早番 (B8、C8から下に) 坂本 遅番 長野 遅番 まずは、勤務表から4月1日だけをとりあえず抜き出そうと、マクロを作って、勤務表マスタから、sheet1である、4月1日には、転記できたのですが、同じように、sheet2(4月2日)、 sheet3(4月3日)…と勤務表マスタから、各シートに転記するには、どうすれば良いのか?分からなくなってしまいました。 力技で、このマクロの「Sheet1」の部分を「Sheet2」にするようにしてといった感じで、あと30個書けば、できるような気もしますが、膨大な行数になりますし、何か他の方法をと考えたのですが、まだまだ、初心者で、どうすれば良いのか全く思いつきません。ここまで、インターネットで調べたりして、何とか作ったもので、全く幼稚なマクロかと思いますが、なにとぞ、ご鞭撻のほど、よろしくお願い致します。 Public Sub test() Dim strSerch1 As String Dim strSerch2 As String Dim LastRow As Long Dim i As Long, j As Long, k As Long '検索する文字を以下の二つの変数に代入 strSerch1 = "早番" strSerch2 = "遅番" 'Sheet1に「早番」の人をリスト化するための変数を設定 '最初に入れるのが3行目なのでjに3を代入 j = 3 With Worksheets("勤務表マスタ") '.Cells(.Rows.Count, 1).End(xlUp).Rowで最後の行がどこなのか調べて 'LastRow変数に代入する。 LastRow = .Cells(.Rows.Count, 1).End(xlUp).Row For i = 2 To LastRow 'ここで2列目を検索して、「早番」の人がいたら、Sheet1の3行目から、リスト化する。 If .Cells(i, 2).Value = strSerch1 Then Worksheets("Sheet1").Cells(j, 2).Value = .Cells(i, 1).Value Worksheets("Sheet1").Cells(j, 3).Value = .Cells(i, 2).Value j = j + 1 End If Next i End With 'Sheet1に「遅番」の人をリスト化するための変数を設定 '最初に入れるのが8行目なのでkに8を代入 k = 8 With Worksheets("勤務表マスタ") LastRow = .Cells(.Rows.Count, 1).End(xlUp).Row For i = 2 To LastRow 'ここで2列目を検索して、「遅番」の人がいたら、Sheet1の8行目から、リスト化する。 If .Cells(i, 2).Value = strSerch2 Then Worksheets("Sheet1").Cells(k, 2).Value = .Cells(i, 1).Value Worksheets("Sheet1").Cells(k, 3).Value = .Cells(i, 2).Value k = k + 1 End If Next i End With End Sub

  • Excel 文字列を検索して全て置換するマクロ

    当方VBA初心者なのですが、ExcelのVBAで作ったマクロでうまく動かなくて困っています。 もしおわかりになる方がいらっしゃったら是非よろしくお願いいたします。 *実現したいこと '”reference”という名前のシートに、次のようなデータが入っています。 (1) りんご (2) みかん (3) キウイ ・・・ これを、配列を2つ用意し、 (1)を配列Listに、(2)を配列List2へ格納して行きます。 '"data"という名前のシートには、A列の1~10行目までに文章が入っていて、 "家には、(1)があります。" "冬になるとよく(2)を食べます。" ・・・・ この全文をcというRangeに設定し、そのcの中において、 もし、配列1((1)等)のキーワードがあったら、 'そのキーワードを配列2(りんご等)の内容に書き換える。 'キーワードは、データシートに複数回出てくる場合もある。 *困っていること 下記のマクロだと、一度目のObjFindまでは成功するのですが、 List(i)を探しているはずが、2回目から、その変更後の文字列が含まれた全文を検索するようになってしまいます。 以下マクロです。 よろしくお願いいたします。 Sub TEST() Dim List() As String, List2() As String 'List Dim i As Integer Dim iRow As Integer iRow = Worksheets("reference").Cells(Rows.Count, 1).End(xlUp).Row ReDim List(iRow) ReDim List2(iRow) For i = 1 To iRow List(i) = Worksheets("reference").Cells(i, 1).Value List2(i) = Worksheets("reference").Cells(i, 2).Value Next i Dim lngYLine As Long Dim intXLine As Integer Dim objFind As Object Dim strAddress As String Dim strSamp As String Dim objRange As Range Dim c As Range For i = 1 To iRow Set objRange = Worksheets("data").Range("A1:A331") Set objFind = objRange.Cells.Find(List(i)) If Not objFind Is Nothing Then For Each c In objRange If c.Value = objFind Then lngYLine = objFind.Cells.Row intXLine = objFind.Cells.Column strSamp = Worksheets("data").Cells(lngYLine, 1) strSamp = Replace(strSamp, List(i), List2(i)) Worksheets("data").Cells(lngYLine, 1) = strSamp MsgBox List(i) + "は" + List2(i) + "に変更されました" Set objFind = Cells.FindNext(objFind) End If Next c Else MsgBox List(i) + "は見つかりませんでした" End If Next i End Sub

  • EXCEL コンボボックスのリスト設定

    リストインデックスが複数ある場合は動くのですが、 インデックスが0 もしくは1個しかない場合は、どのように処理を追加したらいいでしょうか。。 実行時エラー381 Lisプロパティを設定できません。プロパティの配列のインデックスが無効です、と メッセージが出ます。 いろいろ試してるのですがわかりません。 コンボボックスの値は別シートで参照先を指定しています。 ----------- Private Sub ComboBox3_DropButtonClick() Dim lRow As Long Dim i As Long, myCnt As Long Dim myData With Worksheets("部門名") lRow = .Range("O" & Rows.Count).End(xlUp).Row ’O列の最終行を確認 myData = .Range("O2:O" & lRow).Value ’コンボボックスのリストデータ End With With ComboBox3 .ColumnCount = 1 .ColumnWidths = "50" .List = myData End With End Sub

  • Excel VBA ユーザフォームの検索について

    添付の画像のようなユーザフォームを作っています。 TextBox1に検索ワードを入力して、CommandButton1をクリックすると、下のComboBox1に一覧が出るようにしたいと思い、ほかのサイトから下記のコードを見つけて、作ってみました。参照先のsheet2を表示しているときは大丈夫なのですが、別のシートを選んでいるとエラーになります。 sheetは3つあり、それぞれ違うリストが入力されています。今回はsheet2のリストを参照したいのですが、最初はsheet1が表示されている状態で実行したいです。 エラーの内容は 実行時エラー9 インデックスが有効範囲にありません。 コチラがコードです。 Private Sub UserForm_Initialize() Dim i As Long, imax As Long Dim tbl() As Variant imax = ThisWorkbook.Worksheets("sheet2").Cells(Rows.Count, "A").End(xlUp).Row ReDim tbl(imax) For i = 1 To imax tbl(i) = Range("A" & i).Value Next i With ComboBox1 .List() = tbl() End With End Sub Private Sub CommandButton1_Click() Dim i As Long, imax As Long Dim tbl() As Variant Dim cnt As Long, j As Long j = -1 With ThisWorkbook.Worksheets("sheet2") imax = .Cells(Rows.Count, "A").End(xlUp).Row cnt = Application.CountIf(Range("A1:A" & imax), "*" & TextBox1.Text & "*") ReDim tbl(cnt) For i = 1 To imax If InStr(.Range("A" & i), TextBox1.Text) > 0 Then j = j + 1 tbl(j) = Range("A" & i).Value ←この部分がエラーになる End If Next i End With With ComboBox1 .List() = tbl() End With End Sub どこを直せば良いか、教えてください。 よろしくお願いします。

  • エクセル VBA リストについて

    エクセル VBA リストについて ComboBox3が例えばAなら ComboBox5にリストを入れたい 同じBookにSheet”masuta"がありそこに U1 V1 W1 X1 A  B C  D U列の下には”A"があり、Aの項目を入れ込んでいます。 ComboBox3が”A”と表示させた場合 ComboBox5はU列のU3以降の項目が入るようにしたいのですが Set wbMyBook = Workbooks(strMyBookName)エラー表示され 型の一致がしないと表示されます! このBookの格納はしているつもりなのですが上手く 回避できません教えて下さい。 それと下の記述をどのように変化させれば良いか アドバイスお願いします。 Private Const WBHName = "k2.xls" Private Const SH1Name = "Sheet1" Private Const wsListName = "masuta" Dim lngYcnt_List As Long '使用行を格納 Dim wbMyBook As Workbook 'このブックをセット Dim wsList As Worksheet 'リストシートをセット Dim strMyBookName As String 'このブックの名前を格納 Private Sub ComboBox3_Change() Dim lng As Long '使用するブックとシートをセット Set wbMyBook = Workbooks(strMyBookName) Set wsList = wbMyBook.Worksheets(wsListName) 'リストシートの使用行を格納 lngYcnt_List = wsList.Range("masuta!U1:X1").CurrentRegion.Rows.Count 'コンボボックスComboBox1のクリア・フラグをfalseにする。 ComboBox5.Clear flag = False '同じ数字のもののコンボボックスComboBox1に追加。 For lng = 1 To lngYcnt_List If ComboBox3.Value = wsList.Cells(lng, 21) Then 'ComboBox1,TextBox8,呼吸具体策に表示する。 ComboBox5.AddItem wsList.Cells(lng, 21) End If If ComboBox3.Value = wsList.Cells(lng, 22) Then ComboBox5.AddItem wsList.Cells(lng, 22) End If If ComboBox3.Value = wsList.Cells(lng, 23) Then ComboBox5.AddItem wsList.Cells(lng, 23) '処理を抜けるExit For flag = True End If Next lng End Sub

  • エクセル2007 VBA シート内のデータを項目名で検索し、その列を新

    エクセル2007 VBA シート内のデータを項目名で検索し、その列を新規シートにコピーする方法についてです。 VBAについては初心者で、グーグルで調べながら作ったのですが、コピー後のペーストが上手く出来ません。どうすれば最後まで処理できるのかを教えて下さい。 それと、全体的に書き方がおかしいところがありましたら指摘・改善方法を教えて下さい。 よろしくお願いします。 Sub 配列並べ替え() Dim myArray As Variant '1項目名希望順配列格納 Dim strArray As Variant '2検索用1の配列格納 Dim LastCol1 As Long '3最終列数格納 Dim LastCol2 As Long '4新規シートの最終列数格納 Dim DefSheetname As Variant '5初期のシート名取得 Dim i As Long Dim j As Long '初期シート名を取得。 DefSheetname = ActiveSheet.Name '初期シートの最終列数取得。 LastCol1 = Worksheets(DefSheetname).Range("A1").End(xlToRight).Column 'シート名:レポートの新規シート追加。 Worksheets.Add.Name = "レポート" '初期シートを選択。 Worksheets(DefSheetname).Select '項目名希望順配列格納。 myArray = Array("得意先C", "取引先名1", "製番", "相手管理NO", "品目C", _ "製品名1", "受注数", "受注残数", "納期", "受注単価", _ "受注金額", "出荷数", "出荷金額", "出荷先名1", "郵便番号", "住所1", "TEL", "FAX") '配列要素数分繰り返し処理。 For i = LBound(myArray) To UBound(myArray) '検索用の配列(項目名)格納。 strArray = myArray(i) 'A1:LastCol1範囲で配列(項目名)検索し、番号で返す。 j = WorksheetFunction.Match(strArray, Worksheets(DefSheetname).Range(Cells(1, 1), Cells(1, LastCol1)), 0) 'シート名:レポートに変数jの列数目の値を入力。 Columns(j).Copy 'シート名:レポートの最終列数取得。 LastCol2 = Worksheets("レポート").Range("A1").End(xlToRight).Column 'シート名:レポートを選択。 Worksheets("レポート").Select Range(Cells(1, 1), Cells(1, "LastCol2")).Past Next i End Sub

専門家に質問してみよう