• ベストアンサー
  • すぐに回答を!

【Excel】リストボックスにデータを重複せず昇順に表示する方法

教えてください。 ユーザーフォームにリストボックス(Listbox1)があり、日付が昇順で入力されるようになっています。 ただし、この日付データは重複が多いため重複されないよう表示しようと下記のコードを記述しましたが「実行時エラー1004 アプリケーション定義またはオブジェクト定義のエラーです」と表示されてしまいます。 これを回避し、実行させるためにはどういう風に記述を修正したらよいでしょうか? ================================================================ Private Sub UserForm_Initialize() Dim i As Long For i = 2 To 2000 ListBox1.AddItem Worksheets("データ").Cells(i, 1) Dim myValue As Variant Dim myRng As Range, myCell As Range Set myRng = Worksheets("データ").Cells(i, 1).End(xlUp) myValue = myRng.Value Application.ScreenUpdating = False myRng.Sort Worksheets("データ").Cells(i, 1), xlAscending, Header:=xlYes With ListBox1 .Clear For Each myCell In myRng.Resize(myRng.Rows.Count - 1).Offset(1) _ .SpecialCells(xlCellTypeVisible) .AddItem myCell.Value Next .ListIndex = 0 End With Next i ListBox1.ListIndex = 0 End Sub ================================================================

共感・応援の気持ちを伝えよう!

  • 回答数4
  • 閲覧数2053
  • ありがとう数3

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

  • ベストアンサー
  • 回答No.4

> 抽出されたデータが重複しているものが3件あるはずなのに2件しか抽出 > されません。 すみません。寝ぼけてたみたいです。#3 もおかしなコードですね... AddItem ではなく、 List の方が楽なので変更しましたが、これで大丈夫な はずです。きっと(´・ω・`) Private Sub UserForm_Initialize()   Dim i      As Long   Dim lngR    As Long   Dim myRng    As Range   Dim Buffer   As Variant      With Worksheets("データ")     lngR = .Cells(65536, "A").End(xlUp).Row     Set myRng = Range(.Cells(1, "A"), .Cells(lngR, "A"))     myRng.Sort Key1:=myRng(1, 1), Order1:=xlAscending, Header:=xlYes     .Range("B:B").ClearContents     myRng.AdvancedFilter Action:=xlFilterCopy, _                CopyToRange:=.Range("B1"), _                Unique:=True     lngR = .Cells(65536, "B").End(xlUp).Row     Buffer = Range(.Cells(2, "B"), .Cells(lngR, "B")).Value   End With   With ListBox1     .Clear     .List = Buffer     .ListIndex = 0   End With End Sub

共感・感謝の気持ちを伝えよう!

質問者からのお礼

出来ました!! どうもありがとうございました◎

関連するQ&A

  • リストボックスについて

    リストボックスからデータを転記したいのですが、 実行時エラー"1004"が出てしまい、どうしてもうまくいきません。 どなたか原因を教えてください。 Private Sub ListBox1_DblClick(ByVal Cancel As MSForms.ReturnBoolean) Dim i As Long With Worksheets("sheet2") i = .Range("F47").End(xlUp).Row + 1 .Range(i, 6).Value = ListBox1.List(ListBox1.ListIndex, 0) .Range(i, 12).Value = ListBox1.List(ListBox1.ListIndex, 1) .Range(i, 26).Value = ListBox1.List(ListBox1.ListIndex, 2) .Range(i, 28).Value = ListBox1.List(ListBox1.ListIndex, 3) .Range(i, 34).Value = ListBox1.List(ListBox1.ListIndex, 4) .Range(i, 37).Value = ListBox1.List(ListBox1.ListIndex, 5) End With Unload Me End Sub

  • リストボックスの値を拾うには

    リストボックスの値を拾うには 以下のボタンコマンドでListBox1のListIndexから配列二番目の値を「hinban」という変数に取り込みたいのですがうまくいきません。 「hinban = ListBox1.List(ListBox1.ListIndex, 1)」という行を書いてみましたが 「オブジェクトは、このプロパティまたはメソッドをサポートしていません。」とアラートが出てしまいます。 VBA初心者です。 解決法を教えてください。 Private Sub CommandButton1_Click() Dim lastRow As Long Dim i As Integer With Worksheets("Sheet1") lastRow = .Cells(Rows.Count, 1).End(xlUp).Row + 1 'For i = 1 To 3 '.Cells(lastRow, i).Value = ListBox1.List(ListBox1.ListIndex, i - 1) hinban = ListBox1.List(ListBox1.ListIndex, 1) 'Next i End With End Sub

  • VB リストボックス選択項目が取得できない。

    エクセルのユーザフォームで日程表を作っています。 下記ListBox1で会議名称だけ表示させています(チェックボックス無し)。 Private Sub ListBox1_click()で選択さした項目を、ここではあらかじめ結合したF5、F6セルに入力させたいのですが、なにも入力されません。 また、ウォッチウインドゥで cとListIndexとListBox1.Valueを設定し、実行後に見るとListIndex 2、ListBox1.Value : "責任者会議"とそれなりに表示されますが、cはEmptyです。 なぜF5セルと、併せてウォッチウインドゥに変数cが設定されないのでしょうか。教えてください。 Excel 2007 VB6.5です。 '行事入力一覧 Private Sub UserForm_Initialize() With ListBox1 .AddItem "" .AddItem "サービス課会議" .AddItem "責任者会議" .AddItem "安全衛生委員会" .AddItem "ISO委員会"  End With End Sub --------------------------------- Private Sub ListBox1_click() MsgBox ("選択した行事名を「行事等」欄へコピーします。" _ & vbCrLf & vbCrLf & "コピーしたい日付の「行事等」欄をクリックしてください。") Dim ListIndex As Long '選択番号 Dim c As Variant ListIndex = ListBox1.ListIndex With ActiveSheet For i = 0 To -1   c = ListBox1.Value Range("F5").Value = ListBox1.Value ’ Range("F5:F6").MergeCells.Value = ListBox1.Value ’ Cells(5, 6).Value = ListBox1.Value Next i  .Range("G5").Value = "-4A56" 'Test G5とG6の結合セルだが入力される。 End With Stop      ListBox1.Value = ""       Unload Me End Sub

その他の回答 (3)

  • 回答No.3

すみません。#1 のコードはところどころで必要なピリオド抜けが多いので、 バグフィックスしたものを再掲しておきます。スペース節約のため、コメント はカットしてます。  # No.2 のコメントにも一部誤記があります。  # ×降順ソート --> ○昇順ソート Private Sub UserForm_Initialize()   Dim i      As Long   Dim lngR    As Long   Dim myRng    As Range   With Worksheets("データ")     lngR = .Cells(65536, "A").End(xlUp).Row     Set myRng = Range(.Cells(1, "A"), .Cells(lngR, "A"))     myRng.Sort Key1:=myRng(1, 1), Order1:=xlAscending, Header:=xlYes     .Range("B:B").ClearContents     myRng.AdvancedFilter Action:=xlFilterCopy, _                CopyToRange:=.Range("B1"), _                Unique:=True     lngR = .Cells(65536, "B").End(xlUp).Row     Set myRng = Range(.Cells(2, "B"), .Cells(lngR, "B"))   End With   With ListBox1     .Clear     For i = 2 To lngR - 1       .AddItem myRng.Cells(i, 1).Value     Next i   End With   ListBox1.ListIndex = 0 End Sub

共感・感謝の気持ちを伝えよう!

質問者からの補足

解答ありがとうございます。 参考にさせていただいたのですが、抽出されたデータが重複しているものが3件あるはずなのに2件しか抽出されません。 これはどの部分を修正したらよいでしょうか?

  • 回答No.2

AddItem だとちょっと「もたつく」感じがします。配列にして List プロパ ティーで一気に放り込んだ方が高速です。 Range を一次元配列にする方法、配列から重複値をドロップする方法なども あわせて書いてみました。少々難易度はあがりますが、ご参考下さい。 Private Sub UserForm_Initialize()   ' イベントプロシージャ内にはあまり長いコードは書かないで   ' サブプロシージャを呼び出すようにするとコードがスッキリ   ' します   Call SetListbox End Sub ' リストボックスデータセット Private Sub SetListbox()      Dim i      As Long   Dim rngDataTbl    As Range   Dim lngR As Long   Dim Buffer   As Variant      On Error GoTo ERROR_HANDLER      With ThisWorkbook.Worksheets("データ")     ' データの最終行を求め、データ範囲を rngDataTbl に参照     lngR = .Cells(65536, "A").End(xlUp).Row     Set rngDataTbl = Range(.Cells(1, "A"), .Cells(lngR, "A"))   End With   ' 見出し付きで降順ソート   rngDataTbl.Sort Key1:=rngDataTbl(1, 1), Order1:=xlAscending, Header:=xlYes   ' 見出しは不要なので、データ範囲を補正   Set rngDataTbl = rngDataTbl.Offset(1).Resize(rngDataTbl.Rows.Count - 1)   ' データ範囲を一次元配列に変換   Buffer = Application.Transpose(rngDataTbl.Value)   ' 配列から重複データをドロップする   Call GetUniqueArray(Buffer)   ' リストボックスにデータセット   With ListBox1     .List = Buffer     .ListIndex = 0   End With   Set rngDataTbl = Nothing   Exit Sub ERROR_HANDLER:   MsgBox "ListBox にデータを追加できません.", vbExclamation End Sub ' 重複のない配列を生成(サブプロシージャ) Private Sub GetUniqueArray(ByRef Source As Variant)      Dim colTmp As Collection   Dim aryTmp As Variant   Dim vntElm As Variant   Dim i   As Long   On Error GoTo ERROR_HANDLER   Set colTmp = New Collection   ' Collection には同一値を Add できない --> On Error Resume Next   ' にすると、結果として重複値はカットされる   On Error Resume Next   For Each vntElm In Source     If vntElm <> Empty Then       colTmp.Add CStr(vntElm), CStr(vntElm)     End If   Next vntElm   On Error GoTo 0      If colTmp.Count = 0 Then     Exit Sub   Else     ' Collection から配列に戻す     ReDim aryTmp(colTmp.Count - 1)     For i = 1 To colTmp.Count       ' 書式化しておく       aryTmp(i - 1) = Format$(CDate(colTmp.Item(i)), "yyyy/mm/dd")     Next i     Source = aryTmp   End If   Set colTmp = Nothing   Exit Sub ERROR_HANDLER:   Err.Raise 1000, , "重複のない配列の生成に失敗しました." End Sub

共感・感謝の気持ちを伝えよう!

質問者からのお礼

すばらしい解答をありがとうございました。 自分なりに解釈し、参考にさせて頂きます。 ありがとうございました。

  • 回答No.1

こんにちは。KenKen_SP です。 もとのコードを最大限に活用すればこんな感じ。AdvancedFilter で重複値を カットするため、作業用に B列 を使いました。 Private Sub UserForm_Initialize()   Dim i      As Long   Dim lngR    As Long   Dim myRng    As Range   With Worksheets("データ")     lngR = .Cells(65536, "A").End(xlUp).Row     Set myRng = Range(.Cells(1, "A"), Cells(lngR, "A"))     ' 見出し付きでソート     myRng.Sort Key1:=myRng(1, 1), Order1:=xlAscending, Header:=xlYes     ' 重複のない日付をB列に転記     .Range("B:B").ClearContents     myRng.AdvancedFilter Action:=xlFilterCopy, _                CopyToRange:=Range("B1"), _                Unique:=True     ' データ範囲をB列に訂正     lngR = .Cells(65536, "B").End(xlUp).Row     Set myRng = Range(.Cells(2, "B"), Cells(lngR, "B"))   End With   With ListBox1     .Clear     For i = 2 To lngR - 1       .AddItem myRng.Cells(i, 1).Text     Next i   End With   ListBox1.ListIndex = 0 End Sub

共感・感謝の気持ちを伝えよう!

関連するQ&A

  • リストボックスで選択した項目に該当するデーターをラベルに表示する

    よろしくお願いします ユーザーフォームにリストボックスが2つ ラベルが1つ 配置しています。 リストボックス1で選択した項目に該当するリストを リストボックス2に表示する。 次に リストボックス2で選択した項目に該当するデーターを ワークシートのセル(E5:E300)から選んで ラベル1に表示する。 このようにしたいのですがエラーが出ます。 Dim LastRow As Long Dim DstRow As Long Const FstRow As Long = 5 Dim MctRow As Long   -  -  - Private Sub UserForm_Initialize() With Me.ListBox1 .RowSource = Worksheets("入力").Range("A5:A300").Address(External:=True) End With End Sub   -  -  - Private Sub ListBox1_Click() Dim j As Integer Dim RowCnt As Long With Worksheets("入力") LastRow = .Range("E300").End(xlUp).Row ListBox2.Clear For RowCnt = 5 To LastRow If ListBox1.List(ListBox1.ListIndex) = .Cells(RowCnt, 3).Value Then ListBox2.AddItem For j = 0 To 1 ListBox2.List(ListBox2.ListCount - 1, j) = .Cells(RowCnt,5 + j).Value Next j End If Next RowCnt End With End Sub   -  -  - Private Sub ListBox2_Click() Dim SrcCode As Long SrcCode = ListBox2.List(ListBox2.ListIndex, 0)     ↑    ↑    ↑ ここでエラーになります。 実行時エラー 型が一致しません と表示されます With Worksheets("入力") LastRow = .Range("E300").End(xlUp).Row MctRow = Application.WorksheetFunction.Match(SrcCode, .Range("E5:E" & LastRow), 0) + 5 Label1 = Format(.Cells(MctRow, 5)) End With End Sub

  • VBAにてリストボックスに表示された文字をエクセルのセルにコピペするには

    先日、ここで教えてもらった以下の内容で、幾つかのテキストボックスに表示された内容のうち、電話番号をエクセルのセルに転記する方法が、上手くいきません。”検索"名のシート上で実行します。 過去のログを参考にしましたが、解決できませんでした。 またお世話になりますが、だれか教えてください。 Private Sub CommandButton1_Click() Dim Namae As String Dim MeNamae As UserForm Dim ken As String Namae = TextBox1.Text Set MeNamae = UserForm1 Call 検索(Namae, MeNamae) End Sub Public Sub 検索(ByVal Namae As String, ByRef MeNamae As UserForm) Dim Nagasa As Integer Dim i As Long Dim MaxRows As Long Dim kensaku As Worksheet Dim KensakuChar As String Dim ListNamae As String Dim ListChar As String Dim KBanme As Integer Dim LBanme As Integer Set kensaku = Worksheets("顧客データ") MaxRows = kensaku.UsedRange.Rows.Count Nagasa = Len(Namae) MeNamae.ListBox1.Clear For i = 3 To MaxRows ListNamae = kensaku.Cells(i, 3) KBanme = 0 LBanme = 0 Do Do While Nagasa >= KBanme KBanme = KBanme + 1 KensakuChar = Mid(Namae, KBanme, 1) If KensakuChar <> " " Then Exit Do End If Loop Do While Nagasa >= LBanme LBanme = LBanme + 1 ListChar = Mid(ListNamae, LBanme, 1) If ListChar <> " " Then Exit Do End If Loop If KensakuChar = ListChar Then If Nagasa = KBanme Then With MeNamae .ListBox1.AddItem (ListNamae) .ListBox1.List(.ListBox1.ListCount - 1, 1) = i End With End If Else Exit Do End If Loop Until Nagasa <= KBanme Next End Sub Private Sub ListBox1_Click() Dim r As Long With ListBox1 If .ListIndex > -1 Then r = .List(.ListIndex, 1) '選択した名前の行 TextBox6.Value = Worksheets("顧客データ").Cells(r, 3) 'カタカナ名 TextBox2.Value = Worksheets("顧客データ").Cells(r, 5) '漢字名 TextBox3.Value = Worksheets("顧客データ").Cells(r, 7) '住所 TextBox4.Value = Worksheets("顧客データ").Cells(r, 1) '電話番号 TextBox5.Value = Worksheets("顧客データ").Cells(r, 2) '顧客番号 End If End With End Sub Private Sub CommandButton3_Click() 'クリックすると  Worksheets("検索").Cells(, 2) ’このシートの(G2)に上記の電話番号が入力される End Sub

  • 同じコンボボックス、リストボックスを使うには?

    よろしくお願いします。 今、ユーザーフォームを使って製造計画表を作っています。 コンボボックスで会社名、リストボックスで会社ごとの製品名を選択させるとこまで出来ました。 1日に3つの製品を作ることが出来るので、同じ中身のコンボボックス、リストボックスを使って3つ作りたいと思っています。 ユーザーフォームの形的にはこのような感じですが。 1. コンボボックス  リストボックス 2. コンボボックス  リストボックス 3. コンボボックス  リストボックス 今は、1.のとこだけは出来たのですが、2.3.は1.と同じコードをコピーして必要と思われるとこだけをコンボボックス2と変えたりしてみたのですが、上手くいきませんでした。こんなコードですが。 Private Sub UserForm_initialize() 'ComboBox1セット Dim ico As Long ico = 1 With ThisWorkbook.Worksheets("Sheet1") Do While .Cells(1, ico) <> "" Me.ComboBox1.AddItem .Cells(1, ico).Value ico = ico + 1 Loop End With Me.ComboBox1.SetFocus End Sub Private Sub ComboBox1_Change() 'ListBox1セット Dim ico As Long 'Me.ListBox1.Clear ico = Me.ComboBox1.ListIndex + 1 With ThisWorkbook.Worksheets("Sheet1") Me.ListBox1.List = .Range(.Cells(2, ico), _ .Cells(.Cells(Rows.Count, ico).End(xlUp).Row, ico)).Value End With End Sub VBAも初めたばかりで質問の内容もわかりづらいとも思いますが、よろしくお願いします。

  • リストボックス

    すいません以下の処理に困っております。 リストボックスで値を取得して他のリストボックスにその値を 出力したいのですがまったくできません。 <例> リストボックス1 a b c リストボックス2(上で選択した値を出力) a ちなみに構文は、 ------------------------------------------------------------ Private Sub btn選択_Click() ListBox2.Text = ListBox1.Text 'ListBox1.ListIndex + 1 & ": " & ListBox1.Text End Sub Private Sub CommandButton1_Click() End Sub Private Sub ListBox1_DblClick(ByVal Cancel As MSForms.ReturnBoolean) btn選択_Click End Sub Private Sub ListBox2_DblClick(ByVal Cancel As MSForms.ReturnBoolean) btn選択_Click End Sub Private Sub UserForm_Initialize() With ListBox1 .AddItem "スケジューラ" .AddItem "データ変換" .AddItem "DWH Server" .AddItem "PPP Server" .AddItem "ファイヤーウォール" .AddItem "暗号オプション" End With End Sub ---------------------------------------------------- 初心者でまったくできません。 御教授をお願いします。

  • エクセルマクロ_上書き(リストボックスでデータを抽出し、その行へ上書き)

    エクセルマクロ初心者です。(2003使用_ユーザーフォーム,リストボックス,テキストボックス,チャックボックス) Sheet1のデータをユーザーフォームへ反映させ、修正したものをその行へ上書きするマクロを作成したいと思っていますが、うまくいかないのでどなたかお教え願います。 (Sheet1―A8より表がはじまります) 管理番号 品名 数量 希望納期 変更数量 完納 コメント アカ12 みかん     40   8月3日 アオ35 りんご     30   8月5日 クロ54 なし     50   7月7日 アカ98 もも     20   9月1日 アオ43 すいか     35   8月3日 ●完納の行がチャックボックスで、チェックがついたら、”完納”と記載、チェックがついていなかったら空欄のまま。もし表に”完納”と記載されていたら、コマンドボタン1でデータを抽出した時に、チェックがつくようにしたいのです。が、まったくうまくいかないのです。 ●また、コマンド1での抽出データに値を入力したものを上書きすることは一部できるのですが、空欄にしたときに、空欄の状態(無記入)に上書きすることができません。 Private Sub UserForm_Initialize() Dim r As Range Set r = Sheets("Sheet1").Range("A8").CurrentRegion.Offset(1) Set r = r.Resize(r.Rows.Count - 1) With ListBox1 .ColumnWidths = "50;50;0;0;0;0;0" .ColumnCount = 7 .RowSource = r.Address(A8, G) End With End Sub Private Sub CommandButton1_Click() If ListBox1.ListIndex <> -1 Then TextBox1.Value = ListBox1.List(ListBox1.ListIndex, 0) TextBox2.Value = ListBox1.List(ListBox1.ListIndex, 1) TextBox3.Value = ListBox1.List(ListBox1.ListIndex, 2) TextBox5.Value = ListBox1.List(ListBox1.ListIndex, 4) TextBox6.Value = ListBox1.List(ListBox1.ListIndex, 6) End If If Not IsEmpty(ListBox1.List(ListBox1.ListIndex, 3)) Then TextBox4.Value = Format(CDate(ListBox1.List(ListBox1.ListIndex, 3)), "m/d") Else TextBox4.Value = "" End If End Sub Private Sub CommandButton2_Click() If ListBox1.ListIndex <> -1 Then Dim r As Range ' 元データの範囲を取得 Set r = Sheets("Sheet1").Range("A8").CurrentRegion.Offset(1) Set r = r.Resize(r.Rows.Count - 1) ' 日付型かどうかをチェック If IsDate(TextBox4.Value) Then ' 選択されたセルの更新 r(ListBox1.ListIndex + 1, 4) = TextBox4.Value End If r(ListBox1.ListIndex + 1, 7) = TextBox6.Value End If End Sub Private Sub CheckBox1_Click() If ListBox1.ListIndex <> -1 Then Dim l As Range Set l = Sheets("Sheet1").Range("A8").CurrentRegion.Offset(1) Set l = l.Resize(l.Rows.Count - 1) If CheckBox1.Value = True Then l(ListBox1.ListIndex + 1, 5).Value = "完納" If CheckBox1.Value = False Then l(ListBox1.ListIndex + 1, 5).Value = "<>" End If End If End If End Sub すみませんが、ご親切に教えていただけましたら幸いです。 よろしくお願いいたします。

  • 複数選択可能なリストボックス

    Excel VBAの質問をさせてください。 シート(sheet1)のA列、セルA1から以下のデータがあるとします。 みかん りんご バナナ 苺 梨 バナナ バナナ みかん フォームのリストボックスで"みかん"と"バナナ"を選択した際、シート(sheet2)のセルA1にコピーしていきたいのですが機能しません。 単品、"みかん"だけを選択しても何もコピーされません。 どこがいけないでしょうか?? Private Sub UserForm_Initialize()   With ListBox1     .AddItem "みかん"     .AddItem "りんご"     .AddItem "バナナ"     .AddItem "苺"     .AddItem "梨" .MultiSelect = fmMultiSelectMulti   End With End Sub Private Sub CommandButton1_Click() Dim i As Long For i = 1 To 8 If Worksheets("Sheet1").Cells(i, "A").Value = Me.ListBox1.Value Then Worksheets("Sheet1").Cells(i, "A").Copy Worksheets("Sheet2").Cells(i, "A") End If End Sub

  • エクセルVBA ユーザーフォームのリストボックス

    エクセルVBAのユーザーフォームのリストボックスについて教えてください。 現在、以下のようにコードがされています。 Private Sub UserForm_Initialize() With UserForm.ListBox1 .AddItem "ABC" .AddItem "DEF" .AddItem "GHI" .ListIndex = 0 End With End Sub Private Sub ListBox1_Click() With ListBox2 .Clear Select Case UserForm.ListBox1.List(ListBox1.ListIndex) Case "ABC" .AddItem "123" .AddItem "456" .AddItem "789" Case "DEF" .AddItem "456" .AddItem "789" Case "GHI" .AddItem "789" End Select .ListIndex = 0 End With End Sub それで、ユーザーフォームを起動した時点で、ListBox1には"ABC"、ListBox2には"789"を選択し、青く色がついている状態にすることは可能でしょうか。 よろしくお願いします。

  • コンボボックス or リストボックス (複数列表示→値の取得)

    マクロ初心者です。(エクセル2003使用-ユーザーフォーム) 先日はお世話になり、ありがとうございました。 作成していくうちにさらに改良を加えたく、再質問させていただきます。 ※コンボボックス内の表示を複数行表示(Sheet1の管理番号,品名,注文数量)し、そのデータをSheet2のセルA(管理番号),セルB(品名),セルC(注文数量)と貼り付けようとしております。 が、本で探したところ複数行表示のやり方がリストボックスでしかのっていなく、さらに自分で作成したマクロでは動きませんでした。 すみませんが、お力をお貸しください。 (Sheet1) 担当課 客先 管理番号 品名 注文数量 出荷数量 A 岡田さん 1324 りんご 30 20 B 山田さん 1554 みかん 250 70 C 岡田さん 7634 なし 40 25 B 金子さん 4653 みかん 75 70 A 金子さん 6675 りんご 170 60 C 杉浦さん 7789 りんご 200 120 (↓こちらは、前回質問させていただいた内容です。) Private Sub UserForm_Initialize() ComboBox1.RowSource = "Sheet1! C2:C" & Worksheets("Sheet1").Range("C" & Rows.Count).End(xlUp).Row ←ここを複数行用に変更するのでしょうか?いろいろ試したのですがダメでした。 ComboBox1.ListIndex = -1 ComboBox1.SetFocus End Sub Private Sub CommandButton1_Click() Dim lRow As Long With Worksheets("Sheet2") lRow = .Range("A" & Rows.Count).End(xlUp).Row .Range("A" & lRow + 1).Value = ComboBox1.Value End With End Sub (↓こちらは、リストボックスでのマクロですが、動きません) Private Sub UserForm_Initialize() With UserForm2.ListBox1 .ColumnWidths = "70;50;50" .ColumnCount = 3 End With With Worksheets("Sheet1") Dim MyA As Variant Dim i As Long For i = 2 To UBound(MyA, 1) .AddItem .List(i - 2, 0) = Cells(i, 1).Value .List(i - 2, 1) = Cells(i, 2).Value .List(i - 2, 2) = Cells(i, 3).Value Next End With End Sub Private Sub CommandButton1_Click() Dim lRow As Long With Worksheets("Sheet2") lRow = .Range("A" & Rows.Count).End(xlUp).Row .Range("A" & lRow + 1).Value = ListBox1.Value End With End Sub 教えていただけましたら幸いです。 よろしくお願いいたします。

  • エクセルVBA・リストボックスに関する質問です。

    エクセルVBA初心者です。 作成したワークシート名をVBAにてリストボックス内に表示し、それを選択するとそのシートに飛ぶようにしています。 ------------------- Private Sub ListBox1_Change() With ListBox1 Worksheets(.ListIndex + 1).Activate End With End Sub ------------------- Private Sub UserForm_Initialize() Dim wsSheet As Worksheet For Each wsSheet In Worksheets ListBox1.AddItem wsSheet.Name Next wsSheet End Sub ------------------- これではすべてのシートがリストボックス内に反映される為、反映させたくないシート(3シートあるのですが)も一緒に表示されてしまいます。 この表示させたくないシートをリストボックス内に表示させない事は可能でしょうか? 又、できるとしたら、どんな言語を使用すれば良いのでしょうか? ご教授お願い致します。

  • リストボックスでデータを呼び出し→修正を反映させる方法を教えてください

    マクロ初心者です。(エクセル2003使用_ユーザーフォーム) リストボックスで表示した行のデータをユーザーフォームに呼び出し、修正を加える方法を教えてください。 (Sheet1のデータ) 客先 管理番号 品名 注文数量 出荷数量 出荷日 完納状況 G社  1324   パソコン    30    20 K社  1554   プリンタ    250    70    8月9日 J社  7634   テレビ      40    25 K社  4653   パソコン    75    75    6月4日  完納 G社  6675   パソコン    170    60 G社  7789   プリンタ    200    120 表の行数は、日々変動し、出荷日や完納状況欄は、分かり次第記入や変更をするため、空白の箇所もあります。 (コマンドボタン1まで動く(日付が数字になってしまうが)コード) Private Sub UserForm_Initialize()   With ListBox1 .ColumnWidths = "50;50;50" .ColumnCount = 2 .RowSource = "Sheet1!A2:G" & Worksheets("Sheet1").Range("G" & Rows.Count).End(xlUp).Row End With End Sub            →リストに表示されるが、本当は<管理番号>と<品名>を表示させたいです。(今は、客先と管理番号です) Private Sub CommandButton1_Click() TextBox1.Value = ListBox1.List(ListBox1.ListIndex, 5) →日付が数字ででてしまいます。 TextBox2.Value = ListBox1.List(ListBox1.ListIndex, 6) End Sub Private Sub CommandButton2_Click() TextBox1.Value = ListBox1.List(ListBox1.ListIndex, 5) →動きません。 TextBox2.Value = ListBox1.List(ListBox1.ListIndex, 6) →動きません。 End Sub 空白は、空白のまま表示させたり、修正したいと思っています。 (例 管理番号1554の日付を8月14日にのみ修正したい時、そこは修正し、完納欄は空白のまま表示され、空白の状態でコマンド2を押すことができてほしいということです) すみませんが、どなたかご回答よろしくお願いいたします。