• ベストアンサー
※ ChatGPTを利用し、要約された質問です（原文：リストを選択しない場合の登録）

リスト選択なしでの登録方法

このQ&Aのポイント
  • 住所録を作成する際、リストを選択しない場合、10のテキストボックスで入力し、登録ボタンで指定範囲に入力するが、一番最初の行に登録されてしまう問題が発生
  • リストボックスで行を選択すると登録＆更新は可能だが、リストを選択しない場合は登録されない
  • Windows7・SP1 Office2010を使用している
  • Rord
  • お礼率67% (25/37)
回答 全件
ベストアンサー
入力フォームを初期化するときに ListBox1.Index=-1を加…
ListBox1.ListIndexが-1になっていないんじゃないでし…

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

  • ベストアンサー
  • jin34
  • ベストアンサー率80% (17/21)
回答No.2

入力フォームを初期化するときに ListBox1.Index=-1を加えればいいでしょう。 「'データをクリア」の部分にかなと思います。

Rord
質問者

お礼

わざわざ御丁寧な解答ありがとうございます。これ以上聞くのは愚問ですね。 わからなくなって舞い上がっていました。あとは自分で解決します。 本当に有難うございました。

全文を見る
すると、全ての回答が全文表示されます。

その他の回答 (1)

  • jin34
  • ベストアンサー率80% (17/21)
回答No.1

ListBox1.ListIndexが-1になっていないんじゃないでしょうか。 マクロをステップ実行して、 If ListBox1.ListIndex = -1 Then　の次にどの行に飛ぶかを確認すべきかと思います。 もしくは Private Sub CommandButton2_Click()　の次の行に MsgBox ListBox.ListIndex　を挿入して、 リストからの選択なしの時に正しく　-1　と表示されるか見てください。 If文がFalseとなる（＝－１と表示されない）なら、 フォームを初期化するときにListBox.ListIndex=-1を入れてやればいいと思います。 そうでなければ自分には原因不明です。

Rord
質問者

補足

　ご指摘の方法で、If文がFalseとなり正常に最終入力行の次の空白行に入力されます。 ご面倒でしょうが具体的にお願い出来ませんでしょうか？ 勉強不足で申し訳ありません。

全文を見る
すると、全ての回答が全文表示されます。
  1. カテゴリ
  2. [技術者向] コンピューター
  3. プログラミング・開発
  4. Visual Basic

関連するQ&A

  • ユーザーフォームでの登録＆編集

    　ユーザーフォームのリストボックス(RowSource,P6:A26)で選択し14個のテキストボックスで編集しコマンドボタンでSheet(P6:AC26)にコピペしていますが、下記のコードだと無制限に登録されてしまいます。Sheetの範囲内で登録＆編集のコードの書き方がありましたらご教示賜りたく存じます。(番号は自動入力でなくてもいいです。) Windows7・SP1 Office2010 Private Sub CommandButton2_Click() Dim varRag As Variant Dim myArray As Integer Dim i As Long varRag = Array(txtID, txtTextBox2, txtTextBox3, txtTextBox4, txtTextBox5, txtTextBox6, txtTextBox7, txtTextBox8, txtTextBox9, txtTextBox10, txtTextBox11, txtTextBox12, txtTextBox13, txtTextBox14) If TextBox3.Text = "" Then MsgBox "登録すべき内容がありません！", vbExclamation, "確認" Exit Sub End If Application.ScreenUpdating = False Application.Calculation = xlCalculationManual If ListBox1.ListIndex = -1 Then 'リストが選択していなかったら、 Cells(Rows.Count, 16).End(xlUp).Offset(1).Select For myArray = 0 To 9 With Selection txtID = .Row - 5 .Offset(, myArray) = varRag(myArray) End With Next myArray Else i = ListBox1.ListIndex + 6 Range("P" & i).Value = i - 5 Range("Q" & i).Value = TextBox2.Text Range("R" & i).Value = TextBox3.Text Range("S" & i).Value = TextBox4.Text Range("T" & i).Value = TextBox5.Text Range("U" & i).Value = TextBox6.Text Range("V" & i).Value = TextBox7.Text Range("W" & i).Value = TextBox8.Text Range("X" & i).Value = TextBox9.Text Range("Y" & i).Value = TextBox10.Text Range("Z" & i).Value = TextBox11.Text Range("AA" & i).Value = TextBox12.Text Range("AB" & i).Value = TextBox13.Text Range("AC" & i).Value = TextBox14.Text End If 'データをクリア ListBox1.ListIndex = -1 ID.Text = "" TextBox2.Text = "" TextBox3.Text = "" TextBox4.Text = "" TextBox5.Text = "" TextBox6.Text = "" TextBox7.Text = "" TextBox8.Text = "" TextBox9.Text = "" TextBox10.Text = "" TextBox11.Text = "" TextBox12.Text = "" TextBox13.Text = "" TextBox14.Text = "" Application.ScreenUpdating = True Application.Calculation = xlCalculationAutomatic End Sub Private Sub ListBox1_Change() Dim targetRow As Integer With ListBox1 targetRow = .ListIndex ID.Text = .List(targetRow, 0) TextBox2.Text = .List(targetRow, 1) TextBox3.Text = .List(targetRow, 2) TextBox4.Text = .List(targetRow, 3) TextBox5.Text = .List(targetRow, 4) TextBox6.Text = .List(targetRow, 5) TextBox7.Text = .List(targetRow, 6) TextBox8.Text = .List(targetRow, 7) TextBox9.Text = .List(targetRow, 8) TextBox10.Text = .List(targetRow, 9) TextBox11.Text = .List(targetRow, 10) TextBox12.Text = .List(targetRow, 11) TextBox13.Text = .List(targetRow, 12) TextBox14.Text = .List(targetRow, 13) End With End Sub

  • リストボックスと同じセルデーターを削除する

    3時間ほど奮闘していますが、思うようにできません。 よろしくお願いします。（Ｏｆｆｉｃｅ2010　Windows7） ユーザーフォームのリストボックス（摘要リスト）で、選んだ項目と 同じ項目があるセルを、Ｎ3からラスト行の中から探し出して、削除する。 また、その1つ左側（Ｍ列）と、2つ左側（Ｌ列）のセルデーター及び リストボックス（摘要リスト）で、選んだ項目も削除する。 Dim i As Long With ActiveWorkbook.Sheets("勘定科目") 摘要リスト.Clear For i = 3 To Range("N65536").End(xlUp).Row If .Range("N" & i).Value = 摘要リスト.Value Then 摘要リスト.List(.ListIndex, 0) = "" ActiveCell.Offset(0, 0).Value = "" ActiveCell.Offset(0, -1).Value = "" ActiveCell.Offset(0, -2).Value = "" End If Next End With と、したのですが、うまく作動しません。

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

    リストボックスからデータを転記したいのですが、 実行時エラー"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

  • ブック内に特定名のシートがある場合

    はじめまして、こんにちは。 ＶＢＡを最近はじめたばかりの者です。質問が初歩的なもので申し訳ないのですが是非教えてください。 以下を使って、複数ブックの○○というシートから指定セルの内容を抜き出したいと思っています。 ところが、ブックによっては○○というシートが存在しない場合があり、その場合には「インデックスが有効でない」というエラーで動作が止まってしまいます。 ブック内に○○というシートがある場合にのみ動作させるようにするにはどのようにすれば良いのでしょうか。 よろしくお願いします。 Dim wb As Workbook, myRow As Long Dim e As Integer myRow = ThisWorkbook.Worksheets(1).Rows.Count With Application.FileSearch .NewSearch .LookIn = ThisWorkbook.Path .SearchSubFolders = True .FileType = msoFileTypeExcelWorkbooks If .Execute() > 0 Then For i = 1 To .FoundFiles.Count If .FoundFiles(i) <> ThisWorkbook.FullName Then Set wb = Workbooks.Open(.FoundFiles(i), UpdateLinks:=0) Application.ScreenUpdating = False ThisWorkbook.Worksheets(1).Range("A" & myRow).End(xlUp).Offset(1, 0).Value = _ wb.Worksheets("○○").Range("F6").Value ThisWorkbook.Worksheets(1).Range("B" & myRow).End(xlUp).Offset(1, 0).Value = _ wb.Worksheets("○○").Range("F7").Value ThisWorkbook.Worksheets(1).Range("C" & myRow).End(xlUp).Offset(1, 0).Value = _ wb.Worksheets("○○").Range("F8").Value ThisWorkbook.Worksheets(1).Range("D" & myRow).End(xlUp).Offset(1, 0).Value = _ wb.Worksheets("○○").Range("Y6").Value wb.Close False End If Next i Else MsgBox "ファイルがありません。" End If End With 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（入力された「名称」と「個数」をSheet１の表の一番下に追加）、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を使った物を参考にしています。

  • リストボックスの1行目を選択状態にする

    リストボックス 何も選択していないのなら、1行目を選択状態にする というようにするにはどうすればいいでしょうか？ 今は無理やり Sub test() If IsNull(Sheets("Sheet2").ListBox1.Value) = True Then Sheets("Sheet2").ListBox1.Value = "a" End If End Sub としていますが、 「リストボックスの1行目を選択状態にする」 にはどうすればいいですか？ リストボックスがどの業も選択してない時に、 画像のようにしたいです。

  • EXCELのVBAでセル値の移動でエラー

    EXCEL2002のVBAでセル値の移動をVBAでやりたいのですが (1)の様に1行は出来るのですが、(2)の様に２行を移動させるとエラー （実行時エラー1004　アプリケーション定義またはオブジェクト定義のアラーです。）が出てしまいます。 (2)のマクロでどうしてエラーが出るのか分かりません。 エラーを出さずに2行目を移動させる方法を教えてください。 (1)_____________________________________＿＿＿＿＿＿＿＿＿＿＿＿ If Range("L1") <> detachn Then i = 9 While i >= 1 Cells(1, i + 13).Value = Cells(1, i + 12).Value i = i - 1 Wend Cells(1, 13).Value = Range("L1").Value datachn = Range("L1").Value End If (2)________________________________＿＿＿＿＿＿＿＿＿＿＿＿＿＿＿ If Range("L1") <> detachn Then i = 9 While i >= 1 Cells(1, i + 13).Value = Cells(1, i + 12).Value Cells(2, i + 13).Value = Cells(2, i + 12).Value ←ここでエラー i = i - 1 Wend Cells(1, 13).Value = Range("L1").Value Cells(2, 13).Value = Range("L2").Value datachn = Range("L1").Value End If

  • マクロを動かすとき、毎回シート名を変更したい

    マクロを登録しているBOOKに毎月前月の名前のシートを作成し、システムからダウンロードしたデーターを張り付けます。 そのデーターをVlookup関数で検索し「実績」のシートに、値を張り付けしています。 範囲のシート名が「2月」、「3月」と毎月変更になるので、インプットボックス？で変更できるようなコードを教えてください。 検索してできた初心者のコードですので、もっとスマートなコードがありましたら教えてください。よろしくお願いいたします。 エクセル2010を使用しています。 以下コード Sub 毎月集計() Dim i As Byte Dim 範囲 As Range Dim myV As Variant Sheets("実績").Select Set 範囲 = Worksheets("2月").Range("B7:AZ20")←ここをインプットボックスで変更したい For i = Application.InputBox("開始行を半角で入力してください。", Default:=123, Type:=1) To Application.InputBox( _ "最終行を半角で入力してください。", Default:=123, Type:=1) myV = Application.VLookup(Range("B" & i).Value, 範囲, 2, False) If IsError(myV) Then Range("C" & i).Value = "0" Else Range("C" & i).Value = myV End If myV = Application.VLookup(Range("B" & i).Value, 範囲, 3, False) If IsError(myV) Then Range("D" & i).Value = "0" Else Range("D" & i).Value = myV End If myV = Application.VLookup(Range("B" & i).Value, 範囲, 4, False) If IsError(myV) Then Range("E" & i).Value = "0" Else Range("E" & i).Value = myV End If myV = Application.VLookup(Range("B" & i).Value, 範囲, 5, False) If IsError(myV) Then Range("F" & i).Value = "0" Else Range("F" & i).Value = myV End If ’以下51列まで続く 　Next i End Sub

  • Listプロパティについて

    お世話になります。 自分で作ったコードではないので、訂正していたらよくわからなく なってしまいました。 これはsheet1からsheet2にリストボックスから転記するように なっています。MyCol = Arrayの部分を変更したのですが、 参考書で調べてみたのですが、理解出来なかったので、質問しました。 ListIndex8までを転記していることはわかりました。 その後、ListIndexを11列周期で値をMyBufに代入したいと考えています。(言葉が適当なのかはわかりません) 下記の部分を変更すればよいと思うのですが、まずはコードの 意味を理解したいと思うので、このコードの意味をわかりやすく 解説してもらえませんでしょうか？ MyBuf(i, 0) = .List(N, i * 9 + j + 8) Next Range(MyCol(j) & "21:" & MyCol(j) & "42").Value = MyBuf 以下コード Range("AP4").Value = ListBox1.List(ListBox1.ListIndex, 0) Range("AN3").Value = ListBox1.List(ListBox1.ListIndex, 1) Range("AQ3").Value = ListBox1.List(ListBox1.ListIndex, 2) Range("C3").Value = ListBox1.List(ListBox1.ListIndex, 3) Range("C6").Value = ListBox1.List(ListBox1.ListIndex, 4) Range("AH14").Value = ListBox1.List(ListBox1.ListIndex, 5) Range("AM54").Value = ListBox1.List(ListBox1.ListIndex, 7) Range("AH15").Value = ListBox1.List(ListBox1.ListIndex, 251) Range("AH16").Value = ListBox1.List(ListBox1.ListIndex, 252) Range("AH17").Value = ListBox1.List(ListBox1.ListIndex, 253) Range("AH18").Value = ListBox1.List(ListBox1.ListIndex, 254) Dim i As Integer, j As Integer, N As Integer, MyBuf(21, 0), MyCol MyCol = Array("B", "F", "K", "L", "Z", "AB", "AD", "AH", "AK", "AM", "AS") With ListBox1 N = .ListIndex For j = 0 To 8 If j <> 7 Then For i = 0 To 21 MyBuf(i, 0) = .List(N, i * 9 + j + 8) Next Range(MyCol(j) & "21:" & MyCol(j) & "42").Value = MyBuf End If Next End With Exit Sub

  • VBAで処理フラグの立て方

    こういった条件でやりたいのですがうまくいきません・・・ 処理フラグの立て方は間違っていないと思うのですが・・・ ちょっとセルとかは変えてあります。 もしE3の値が４で割り切れたら8行目を削除し次の処理は行わない もしE3の値が４で割り切れなかったらE4の値が４で割り切れるか処理をする。 割り切れたら18行目を削除 E3とE4の値両方が４で割り切れなかったら8行目を削除し1行あがるので17行目を削除したいです Sub rdlt() If Range("I1").Value = 0 Then Range("I1").Value = 1 '処理は一度きり If Range("E3").Value Mod 4 = 0 Then Rows("8:8").delete '4で割れたとき8行目を削除 Range("J1").Value = 1 '4で割れたときは次の処理用にフラグ End If If Range("J1").Value = 0 Then 'E3が4で割れなかったときは処理する If Range("E4").Value Mod 4 <> 0 Then Rows("18:18").delete Range("J1").Value = 1 End If End If End If End Sub

注目のQ&A

カテゴリ

専門家に質問してみよう

職業から探して質問する

あなたにピッタリな商品が見つかる！ OKWAVEセレクト

質問する