VBAによるリストボックスの文字転記方法

このQ&Aのポイント
  • VBAを使用してリストボックスに表示された文字をエクセルのセルにコピーする方法がわかりません。
  • 以前のログを参考にしましたが、問題を解決できませんでした。
  • どなたか教えていただけないでしょうか?
回答を見る
  • ベストアンサー

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

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

  • ベストアンサー
  • redfox63
  • ベストアンサー率71% (1325/1856)
回答No.1

Private Sub CommandButton3_Click() 'クリックすると  ’このシートの(G2)に上記の電話番号が入力される  ' Cellsは 行、列の順に指定します  Worksheets("検索").Cells(2, 7).Value = TextBox4.Value End Sub

shosin999
質問者

お礼

本当に初心者の質問をお答えいただきありがとうございました。 お手数をおかけいたしました。

関連するQ&A

  • VBAにてリストボックスで選択すると別ブックにあるデータを個別の窓へ表示させるには?

    はじめまして、ゴールデンウィーク中にVBAを勉強していますが、上手くいきません。内容は、「UserForm1を使って別シートにあるデーターから検索を行い、ListBox1に抽出されたリストを選択すると個別のTextBox2に関連する詳細を表示させる」というものです。別シートには「顧客データ」があり、A列より「担当、氏名、カタナカ、住所、電話番号・・・」とデーターが並んでいます。中途半端な状態ですが、これ以上進めません。だれか助けてください。 Private Sub CommandButton1_Click() Dim Namae As String Dim MeNamae As Object Dim ken As String Namae = TextBox1.Text Set MeNamae = UserForm1 Call 検索(Namae, MeNamae) End Sub '受付画面に検索画面窓を出し、顧客データから検索した結果を出すマクロ Public Sub 検索(ByVal Namae As String, ByRef MeNamae As Object) Dim Nagasa As Integer Dim i As Long Dim MaxRows As Long Dim kensaku As Object 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) End With End If Else Exit Do End If Loop Until Nagasa <= KBanme Next End Sub Private Sub ListBox1_Click() With ListBox1 If .ListIndex > -1 Then TextBox2.Value = .List(.ListIndex, 0)’←これでは何の意味も無い ' TextBox2.Value = kensaku.Cells(kensakuIndex, 3) ' TextBox2.Value = kensaku.Cells(kensaku, 3) ' TextBox2.Text = kokyaku.Hoken4 '      TextBox2.Text = kokyaku.Cells(i, 5) End If End With End Sub

  • エクセル VBA リストボックス 一覧処理

    エクセル VBA リストボックス 一覧処理 シートから文字列を検索 ↓ リストボックス表示 ↓ 表示結果をクリック ↓ 空欄時入力 ↓ 更新 上記の流れをVBAで行いたいのですが、結果表示されたリストを選択 詳細を表示し、空欄においては都度入力した物を更新ボタンでセルへ 反映させるにはどの様にすればいいのでしょうか? Public Sub 検索(ByVal Namae As String, ByRef MeNamae As Object) Dim Nagasa As Integer Dim i As Long Dim MaxRows As Long Dim SAGASU As Object Dim KensakuChar As String Dim ListNamae As String Dim ListChar As String Dim KBanme As Integer Dim LBanme As Integer Set SAGASU = Worksheets("2月") MaxRows = SAGASU.UsedRange.Rows.Count Nagasa = Len(Namae) MeNamae.ListBox1.Clear For i = 3 To MaxRows ListNamae = SAGASU.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) End With End If Else Exit Do End If Loop Until Nagasa <= KBanme Next End Sub --------------- Private Sub UserForm_Initialize() Set SAGASU = Worksheets("2月") Maxl = SAGASU.UsedRange.Rows.Count End Sub --------------- Private Sub CommandButton1_Click() Dim Namae As String Dim MeNamae As Object Namae = TextBox1.Text Set MeNamae = KensakuForm Call 検索(Namae, MeNamae) End Sub ---------------- Private Sub CommandButton2_Click() End End Sub ---------------- Private Sub ListBox1_Click() ListIdx = ListBox1.ListIndex Namae = ListBox1.List(ListIdx) End Sub 文字数制限の為、一部抜いていま

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

    VBA初心者です。どうぞよろしくお願いします。 ユーザーフォームにタブつきのリストボックスを作りたいと思っています。 リストはsheet1の中にあります。   A    B    C    D・・・ 1  NO  品名  売場 2  1  いちご  果物 3  2  みかん  果物 4  3  もも    果物 5  4  ハクサイ 野菜 6  5  キャベツ  野菜 7  6  きゅうり  野菜 8  7 9 果物のタブには、果物の品名が表示される。 1 いちご 2 みかん 3 もも 野菜のタブには、野菜の品名が表示される。 4 ハクサイ 5 キャベツ 6 きゅうり 青果のタブには、果物、野菜が表示される。 1 いちご 2 みかん 3 もも 4 ハクサイ 5 キャベツ 6 きゅうり 本を見ながら格闘しておりますが、きっと的違いで滅茶苦茶なことをしているのだと思います。 どうにも出来ず困っております。どなたか教えていただけないでしょうか。よろしくお願いします。 Private Sub UserForm_Initialize() Dim LastRow As Long Dim i As Integer Dim ListBoxNo As Integer Dim ListBox As Control Dim Listtabu(3) As Long 'タブの数 For i = 1 To 3 Listtabu(i) = 0 Next i Worksheets("sheet1").Activate With Worksheets("sheet1") LastRow = .Range("A65536").End(xlUp).Row For i = 2 To LastRow If Worksheets("sheet1").Range(Cells(i, 3)) = "果物" Then ListBoxNo = 1 Set ListBox = 果物 果物.List = Worksheets("sheet1").Range(Cells(i, 1), Cells(i, 2)).Value End If If Worksheets("sheet1").Range(Cells(i, 3)) = "野菜" Then ListBoxNo = 2 Set ListBox = 野菜 野菜.List = Worksheets("sheet1").Range(Cells(i, 1), Cells(i, 2)).Value End If If Worksheets("sheet1").Range(Cells(i, 3)) = "果物" & "野菜" Then ListBoxNo = 3 Set ListBox = 青果 青果.List = Worksheets("sheet1").Range(Cells(i, 1), Cells(i, 2)).Value End If ListBox.AddItem ListBox.List(Listtabu(LstBxNo), 0) = Worksheets("sheet1").Cells(i, 1).Value ListBox.List(Listtabu(LstBxNo), 1) = Worksheets("sheet1").Cells(i, 2).Value Listtabu(LstBxNo) = Listtabu(LstBxNo) + 1 Next End With End Sub

  • EXCEL VBA リストボックスの表示について

    EXCEL VBA リストボックスの表示について Dim rngCell As Range Dim strStr As String Dim strCom As String Dim strId As String UserForm1.ListBox1.Clear strStr = UserForm1.TextBox.text If strStr = "" Then Exit Sub ThisWorkbook.Worksheets("sheet1").Activate For Each rngCell In [a:a] If rngCell.Value Like "*" & strStr & "*" Then If InStr(strCom, rngCell.Value) = 0 Then strCom = rngCell.Offset(0, 5).Value UserForm1.ListBox1.AddItem strCom strCom = "" strId = rngCell.Offset(0, 6).Value UserForm1.ListBox1.AddItem strId strId = "" End If End If Next End Sub 上記のようなコードを作成しました。 キーワードを入力すると決まった行から結果を出力しリストボックスに表示します。 2つの行から結果が出力されるのですがリストボックスの結果表示が上下になってしまいます。 希望としては aaaaa bbbbb と言うように横表示になればと思っています。 &でつなげる方法もありますがリストボックスのColunmWidthsで指定したとおりの間隔で表示させたいと思っています。 どうか助言をお願いいたします。

  • EXCEL リストボックスのデータから除外したい

    次の3項目のフォームがあります。 "番号" "お店" "分類" これら項目に入力した値からシートデータベースの情報をリストボックスに表示させているのですが、"分類"にあるABCDEの情報のうちDの情報を省いて表示させたいのですがわかりません。 省く指定はチェックボックスを考えています。 ご教授よろしくお願いいたします。 ↓コード Private Sub SetListBox() Dim wRow As Long Dim wLstRow As Long Dim wHitFlg As Boolean Me.lst顧客リスト.Clear wLstRow = 0 With Worksheets("顧客情報") For wRow = 2 To .Range("A1").CurrentRegion.Rows.Count wHitFlg = True If Me.txt顧客名 <> "" Then If InStr(1, .Cells(wRow, .Range("顧客名列").Column), Me.txt顧客名, vbTextCompare) = 0 Then wHitFlg = False End If End If If Me.cmb顧客分類 <> "" Then If .Cells(wRow, .Range("顧客分類列").Column) <> Me.cmb顧客分類 Then wHitFlg = False End If End If If Me.TextBox1 <> "" Then If InStr(1, .Cells(wRow, .Range("フリガナ列").Column), Me.TextBox1, vbTextCompare) = 0 Then wHitFlg = False End If End If If wHitFlg = True Then Me.lst顧客リスト.AddItem "" Me.lst顧客リスト.List(wLstRow, 0) = wRow Me.lst顧客リスト.List(wLstRow, 1) = Worksheets("顧客情報").Cells(wRow, 2) Me.lst顧客リスト.List(wLstRow, 2) = Worksheets("顧客情報").Cells(wRow, 3) Me.lst顧客リスト.List(wLstRow, 3) = Worksheets("顧客情報").Cells(wRow, 8) wLstRow = wLstRow + 1 End If Next End With

  • エクセルVBAのユーザーフォームにセルデータを

    Excel2007を使っています。 VBA初心者ですがユーザーフォームのテキストフォームにエクセル内のセルデータを表示させたいと考えています。 以下のコードをユーザーフォームのコードに書いてユーザーフォームを走らせましたがユーザーフォームは表示するのですがデータがまったく表示されません。 どなたかご教授いただけませんでしょうか。 Sub Farst() Dim Data1 As String Dim Data2 As String Dim Data3 As String Dim Data4 As String Dim Data5 As String Dim Data6 As String Dim Data7 As String Dim Data8 As String Dim Data9 As String Dim Data10 As String Dim ActiveRow As String ActiveRow = 4 With Worksheets("MDH,MDO") Data1 = .Cells(ActiveRow, 1) Data2 = .Cells(ActiveRow, 2) Data3 = .Cells(ActiveRow, 3) Data4 = .Cells(ActiveRow, 4) Me.TextBox1連番.Text = Data1 Me.TextBox2品番.Text = Data2 Me.TextBox3品番2.Text = Data3 Me.TextBox4品番3.Text = Data4 End With End Sub

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

    よろしくお願いします ユーザーフォームにリストボックスが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

  • リストボックスの内容を検索したいが...

    エクセル2019を使っています。 添付画像のようにユーザーフォームにテキストボックスとリストボックスを作り、テキストボックスに入力した文字でリストボックスの内容を検索しようとコードを作成しました。 Private Sub TextBox1_Change() Dim LastRow As Integer Dim rng As Range, r As Range With Worksheets("Sheet1") If .AutoFilterMode <> True Then .Range("A1").AutoFilter End If LastRow = .Cells(Rows.Count, 1).End(xlUp).Row .Range("A1").AutoFilter 1, "*" & TextBox1.Value & "*" If .Cells(Rows.Count, "A").End(xlUp).Row > 1 Then Set rng = .Range("A2:A" & LastRow).SpecialCells(xlCellTypeVisible) Else Me.ListBox1.Clear Exit Sub End If End With Me.ListBox1.Clear With Me.ListBox1 For Each r In rng .AddItem r.Value .List(.ListCount - 1, 1) = r.Offset(0, 1).Value Next r End With End Sub Private Sub UserForm_Initialize() Dim LastRow As Integer Dim rng As Range, r As Range With Worksheets("Sheet1") If .AutoFilterMode <> True Then .Range("A1").AutoFilter End If LastRow = .Cells(Rows.Count, 1).End(xlUp).Row Set rng = .Range("A2:A" & LastRow) End With With Me.ListBox1 .ColumnCount = 1 For Each r In rng .AddItem r.Value .List(.ListCount - 1, 1) = r.Offset(0, 1).Value Next r End With ListBox1.ListIndex = 0 End Sub とりあえず検索はできるのですが、使用されていない文字や記号を入力したあとにバックスペースキーで入力した文字や記号を削除するとリストボックスの内容が意図した内容で表示されません。 どこを修正したらいいでしょうか。

  • EXCEL2003 VBA リストボックス

    お世話になります。 質問の内容についてですが、 現在VBAの勉強をしながらデータベースを組んでいます。 そこで、次のようなものを作っています。 Sheet1に於いて、     A    B     C 1  追番  名称   個数 2   1   りんご   1個 3   2   みかん  2個 4   3   なし    3個 5   4   なす    5個 というような表があるとします。 そして、VBAでフォームをつくり、TextBox1(名称入力用)、TextBox2(個数入力用)、ListBox1(すでに入力されているもの及び追加分のリスト用)、CommandButton1(入力された「名称」と「個数」をSheet1の表の一番下に追加)、CommandButton2(フォームを閉じる)という構成にしています。 また、Sheet1上にコマンドボタンを作っており、そのボタンを押すとフォームを呼出すようにしています。 流れとしては、既存の表に追加する場合、コマンドボタンを押してフォームを呼出し、テキストボックスに入力した内容をSheet1の一番下に追加する。また、フォーム上のリストボックスでも現在の表の内容を見る事ができる、というものです。 フォームでのコードは以下のようにしています。 Private Sub CommandButton1_Click() If TextBox1.Value = "" Then MsgBox "「名称」は必須項目です。" End If If TextBox2.Value = "" Then MsgBox "「個数」は必須項目です。" End If If TextBox2.Value = "0" Then MsgBox "「個数」に0は登録できません。" End If Lrow = Range("B2").CurrentRegion.Rows.Count Range("B" & Lrow + 1).Value = TextBox1.Value Range("C" & Lrow + 1).Value = TextBox2.Value End Sub Private Sub CommandButton2_Click() Unload UserForm1 End Sub Private Sub UserForm_Initialize() Dim b As Long Dim a() As String ReDim a(1 To 100) UserForm1.ListBox1.ColumnCount = 2 UserForm1.ListBox1.List = Worksheets(Sheet1).Range("B2:C").Value For i = 2 To 104 If Range("B" & i) = "" Then ListBox1.AddItem Range("B" & i).Value ListBox1.AddItem Range("c" & i).Value b = b + 1 a(b) = Range("C" & i).Value End If Next i End Sub このコードでSheet1上のコマンドボタンを押して実行しようとするとエラーが出てしまいます。 エラーの原因は何なのでしょうか? (なお、コマンドボタンのコードは「UserForm1.Show」のみです。 コード自体は本などを読みながら似たようなVBAを使った物を参考にしています。

  • VBAで空欄にデータに表示

    エクセルVBAのIFを使って、シートaのA列に値があって、B列が空欄の場合のみ、空欄のセルにシートbの値を表示させたいです。 上手くできませんでしたので、教えてください。 Sub Do文2() Dim i As Integer i = 1 If Worksheets("a").Cells(i, 2) = "" Then Do While Worksheets("a").Cells(i, 1) <> "" Worksheets("a").Cells(i, 2) = Worksheets("b").Cells(1, 1) i = i + 1 Loop End If End Sub