- ベストアンサー
Findステートメントで特定の行番号を取得する
ユーザーフォーム中のテキストボックスに入力した数字を検索してその行番号を返したいと思い以下のコードを書いてみました。 Private Sub CommandButton1_Click() Dim Ylin As Long Dim No As Long No = TextBox1.Text Yline = Worksheets("Sheet2").Range("B").Find("No",LookAt:=lWhole).Rows With Worksheets("ひな型") .Cells(11, "D").Value = ComboBox1.Value .Cells(16, "D").Value = ComboBox2.Value .Cells(27, "F").Value = Cells("Yline", 5).Value End With Me.Hide End Sub すると実行時エラー380となり、どうもRowsourseプロパティを設定できないとの事。さまざまなサイトを検索してみましたがFindステートメント+Rowで行番号を取得している例はいくつも見受けられるためどうにも納得いきません。 ご指摘宜しくお願いします。
- tatekenta
- お礼率62% (129/206)
- オフィス系ソフト
- 回答数7
- ありがとう数2
- みんなの回答 （7）
- 専門家の回答
質問者が選んだベストアンサー
こんばんは。 割り込み失礼します。 今、私が書く時点で、#4のimogasiさんのレスが付いていないようですが、imogasiさんがご指摘のことを別の見方をすれば、 また、#4のimogasiさんのご指摘の、'Rows' ですが、Rowsで値が取れないわけではないけれども、それは、見つけたセルの行数ではなく、行の配列です。#1の補足で直したようですが……。 >Dim No As Long Variant 型にしておいたほうがよいでしょうね。全体的な問題とは関係ないけれども、指摘していることは正しいと思います。Valで数値化するのは悪くないのですが、Find メソッドを使っているので、そのまま、検索値に入れてしまいます。 全体的にみると、入力値のチェックがされていないので、初歩的な問題がクリアされていないように思います。 Private Sub CommandButton1_Click() Dim Yline As Long Dim No As Variant Dim c As Range Dim sh2 As Worksheet '便宜的にsh2の変数に入れたけれども、単に見やすくするため Set sh2 = Worksheets("Sheet2") 'コンボボックスのどちらかに入れていない場合は、離脱 If ComboBox1.Value = "" Or ComboBox2.Value = "" Then Exit Sub No = TextBox1.Text 'テキストボックスに値が入っていた場合 If No <> "" Then 'Find メソッドの最低のプロパティは入れる。SearchOrder は特にいらない Set c = sh2.Range("B:B").Find( _ What:=No, _ LookIn:=xlValues, _ LookAt:=xlWhole, _ SearchOrder:=xlByRows) '見つかった場合にのみ、値を入れる If Not c Is Nothing Then Yline = c.Row With Worksheets("ひな型") .Cells(11, 4).Value = ComboBox1.Value .Cells(16, 4).Value = ComboBox2.Value .Cells(27, 6).Value = sh2.Cells(Yline, 5).Value End With 'UserForm は、Hide よりも、Unload のほうが安全 Unload Me Else MsgBox No & " は見つかりません。", 48 End If End If Set sh2 = Nothing End Sub なお、 >ComboBox1.ColumnCount = 1 >ComboBox1.RowSource = "sheet3!A:A" >ComboBox2.ColumnCount = 1 >ComboBox2.RowSource = "sheet4!A:A" 出来る限り、RowSource は、空白値が含まれる可能性があるので、実害がないものの、実体のある範囲にしてください。 >Findステートメント以外に検索タイプの行番号を返すものがあるといいのですが・・・。 検索は、1列なので、ワークシートのMatch 関数を使いますが、VBAでは、戻り値の変数の方が分からないレベルでは使いこなせないです。受ける変数は、Variant 型にして、Excel 97 書式の、Application.Match とします。しかし、まず、Find が使えるようになってからのほうがよいです。
その他の回答 (6)
- fujillin
- ベストアンサー率61% (1594/2576)
通りがかりで、横からですが・・・ ＞実行時エラー9 インデックスが有効範囲内にありませんと出ました ＞sheet1からsheet4まで存在しています。 ＞ひな型というのはshee1の名前です。 などの補足から気になったのは、シート名とシートのオブジェクト名を混同していないだろうかということ。 Sheet2の名前はSheet2でしょうか？ それとも「ひな型」のように違う名前がついてたりしませんか？ Worksheets("Sheet2").Range("B:B").Find("No",LookAt:=xlWhole).Row だと、「Sheet2」という名前のシートを指定しています。 ひな型をSheet1と識別するように、オブジェクト名で表記するなら Sheet2.Range("B:B").Find("No",LookAt:=xlWhole).Row になりますが、こちらの表記法は紛らわしいので、あまり使用する人はいないのではないでしょうか。 この他にも Worksheets(2).Range("B:B").Find("No",LookAt:=xlWhole).Row あるいは xを変数として Worksheets(x).Range("B:B").Find("No",LookAt:=xlWhole).Row などのような指定方法もありますが、それぞれ意味が変わります。 その他の指摘は、それぞれの回答ででていますので・・・ こちらの勘違いでしたら、無視してください。
お礼
ご指摘有難うございます。 ご指摘のとおりShhet2にも名前がついております。No.6さんの御礼にも書いたようにVBAに取り組んで1ヶ月そこそこです。まだ、オブジェクトやクラスなどはあやふやなところが多いです。 No.6さんに提供していただいたコードでも同様のエラーが直りませんでしたが、Setステートメントの部分のシート名をシートのラベル名にしてみたところすんなり走りました。(最初に自分で書いたものでは結局だめでしたが) 結局、何が原因だったのか個人的にはあやふやですが、参照先の表記を変えることで解決できたのならおそらくNo.7さんのご指摘の内容がもっとも関係がありそうなことなのでそこら辺をさらに勉強してみようと思います。
- xls88
- ベストアンサー率56% (669/1189)
>実行時エラー9 インデックスが有効範囲内にありません Yline = Worksheets("Sheet2").Range("B:B").Find(No, LookAt:=xlWhole).Row で上記エラーになるなら、Worksheets("Sheet2")しかないと思います。 >sheet1からsheet4まで存在しています。 ということですが、 With Worksheets("ひな型") で登場する「ひな型」という名前のシートは存在しないのですか？ それとも「ひな型」という名前のシートは他のブックにあるのですか？ もし他のブック、ということなら Workbooks("ブック名.xls").Worksheets("Sheet2") というように、ブック名で修飾してみてください。
補足
ひな型というのはshee1の名前です。 ご指摘どおりworkbooks等できる限り参照先を詳細にしてみましたが効果がありません。(同じエラーです。) ちなみに完全一致など、変えられる条件は変えたりsheet2の検索列に入れている数字の書式などもチェックしてみました。 他に提示していない情報としては、フォームを開いたときのInitializeについてです。 Private Sub UserForm_Initialize() Application.ScreenUpdating = False ComboBox1.ColumnCount = 1 ComboBox1.RowSource = "sheet3!A:A" ComboBox2.ColumnCount = 1 ComboBox2.RowSource = "sheet4!A:A" Application.ScreenUpdating = True Worksheets("ひな型").Activate End Sub このようにしているのでTextbox1にたいしてどうこうというのは無いと思うのですが、これ以上は(実はもうこれで2日ほど費やしています)ちょっとつめられないのでアドバイスがいただけないときは別な検索方法を考えてみようと思います。 Findステートメント以外に検索タイプの行番号を返すものがあるといいのですが・・・。
- imogasi
- ベストアンサー率27% (4737/17068)
>Range("B"). はRange("B：B"). ＞Find("No",LookAt:=lWhole).Rows はFind(No,LookAt:=lWhole).Rows でしょう。 Worksheets("Sheet2").Range( は Worksheets("Sheet2").を前もってActivateしておいたほうが良さそう。 NoはテキストボックスのTEXTには数字文字列ではいりますが、セルは数値ですか。合わせておいたほうがよいと思う。 ＞LookAt:=lWhole).Rows は.Rowの方が良いのでは。 ＞Rowsourseプロパティを設定できないとの 質問実例には載っていないが。突然ですが。 ーー どこまで役立つかわかりませんが参考になれば。
- xls88
- ベストアンサー率56% (669/1189)
対象ブックに、Sheet2 は存在していますか？
補足
さすがにその点は心配ありません。 sheet1からsheet4まで存在しています。 またそれぞれのシートはすでにデータを書き込んで表にしてあり、あとは検索マクロを作製しさえすれば目標の状態に持っていくことができるようにしてあります。
- xls88
- ベストアンサー率56% (669/1189)
エラーになる行はここですか？ .Cells(27, "F").Value = Cells("Yline", 5).Value Cellsプロパティの、行インデックスが文字列になっています。 Excelに、そのような行はありません。
補足
エラー行を提示していませんでした。すみません。 エラー構文は Yline = Worksheets("Sheet2").Range("B:B").Find(No, LookAt:=xlWhole).Row の部分です。 ご指摘の箇所も訂正します。
- xls88
- ベストアンサー率56% (669/1189)
B列が対象なら Worksheets("Sheet2").Range("B") は Worksheets("Sheet2").Range("B:B") ではないでしょうか。 折角の変数が文字列になっています。 No = TextBox1.Text Worksheets("Sheet2").Range("B:B").Find("No", LookAt:=lWhole).Rows は、ダブルクオーテーションで挟んではいけません。 No = TextBox1.Text Worksheets("Sheet2").Range("B:B").Find(No, LookAt:=lWhole).Rows です。 スペルミス（？）が２ヶ所あります。 Worksheets("Sheet2").Range("B:B").Find(No, LookAt:=lWhole).Rows は、 Worksheets("Sheet2").Range("B:B").Find(No, LookAt:=xlWhole).Row lWholeはxが欠落、Rowsはsが余分
補足
早々に回答していただきありがとうございます。スペルミスにつきましてはお恥ずかしい限りです。 ご指摘の部分を直してみました。フォームに入力してコマンドボタンをおすと実行時エラー9 インデックスが有効範囲内にありませんと出ました。 引き続き自分でも調べてみていますが、思い当たる改善案がありましたらご指導下さい。 Private Sub CommandButton1_Click() Dim Yline As Long Dim No As Long No = Val(TextBox1.Text) Yline = Worksheets("Sheet2").Range("B:B").Find(No, LookAt:=xlWhole).Row With Worksheets("ひな型") .Cells(11, "D").Value = ComboBox1.Value .Cells(16, "D").Value = ComboBox2.Value .Cells(27, "F").Value = Cells("Yline", 5).Value End With Me.Hide End Sub
関連するQ&A
- Findステートメントで別なブックの検索
Findステートメントで検索した内容のある行のA列にある値をキーワードとして別なブックのA列に検索をかけてヒットしたセルの内容を元のブックの指定したセルに移すという動作をさせたいので次ののように書いてみました。 Private Sub CommandButton2_Click() Dim Yline As Long Dim No As Variant Dim c As Range Dim sh As Worksheet Dim sh_no As Integer Dim findcell As Range Dim add As String Set sh = Worksheets("ブックAの1") No = TextBox1.Text sh_no = 1 'テキストボックスに値が入っていた場合 If No <> "" Then 'Find メソッドの最低のプロパティは入れる。SearchOrder は特にいらない Set c = sh.Range("B:B").Find( _ What:=No, _ LookIn:=xlValues, _ LookAt:=xlPart, _ Searchorder:=xlByRows) '見つかった場合にのみ、値を入れる If Not c Is Nothing Then Yline = c.Row '見つかった行のA列の文字列でブックBに検索をかける add = sh.Cells(Yline, 1).Value Workbooks("B").Activate Set findcell = Workbooks("B").Worksheet(sh_no).Range("A:A").Find( _ What:=add, _ LookIn:=xlValues, _ LookAt:=xlPart, _ Searchorder:=xlByRows) '前Setステートメントからのループ検索開始 If findcell Is Nothing Then Do sh_no = sh_no + 1 If sh_no > ThisWorkbook.Worksheets.Count Then Exit Sub End If Set findcell = Workbooks("B").Worksheets.(sh_no).Range("A:A").Find( _ What:=add, _ LookIn:=xlValues, _ LookAt:=xlPart, _ Searchorder:=xlByRows) Loop While findcell Is Nothing End If End If Workbooks("A").Activate With Worksheets("Aの2") .Cells(21, 4).Value = sh.Cells(Yline, 14).Value .Cells(20, 4).Value = sh.Cells(Yline, 15).Value .Cells(36, 4).Value = findcell End With Unload Me Else MsgBox No & " は見つかりません。", 48 End If Set sh = Nothing End Sub するとwhat:=addとしてaddが見つかるまでシート番号を増やしていくループのところでエラーがでてキーワードが見つからないと出ます。恐らくブックBを検索してくれているとは思うのです。A列に空白があるためかと思い埋めてみましたが関係ないようです。 構文エラー的なものは無いと思いますが、宜しくお願いします。
- ベストアンサー
- オフィス系ソフト
- ユーザーフォームをWorkSheet(1)に固定
●質問の主旨 WorkSheet(1)（「柴田8月分」）にユーザーフォームを固定的に 表示させつつ、WorkSheet(1)以降のWorkSheet(2）、 WorkSheet(3）、WorkSheet(4）の表を参照しながら ComboBox1、ComboBox2、ComboBox3にリストを 選択して、データベースに入力したいと考えています。 以下のコードをどのように書き換えれば良いでしょうか？ ご教示のほどよろしくお願い申し上げます。 ●質問の補足 現在のコードでは、ComboBox1、ComboBox2、ComboBox3を それぞれ選択しているとユーザーフォームがそれぞれ WorkSheet(2）、WorkSheet(1)（顧客リスト）、WorkSheet(3）（社員名）、 WorkSheet(4）（大分類）にとんでしまいます。 転記入力が終了すると、また手作業でWorkSheet(1)に戻らなければなりません。 その手作業を回避したいと考えています。 なお添付画像はComboBox1の選択前なのでWorkSheet(1) に留まってくれています。 ●コード Option Explicit 'ユーザーフォームの初期化 Private Sub UserForm_Initialize() Dim r As Range Dim n As Range Dim d As Range With Worksheets(2) Set r = .Range("C3", .Cells(.Rows.Count, 2).End(xlUp)) End With With Me.ComboBox1 .ColumnCount = 2 .ColumnWidths = ";0" .List = r.Value End With With Worksheets(3) Set n = .Range("C3", .Cells(.Rows.Count, 2).End(xlUp)) End With With Me.ComboBox2 .ColumnCount = 2 .ColumnWidths = ";0" .List = n.Value End With With Worksheets(4) Set d = .Range("C3", .Cells(.Rows.Count, 2).End(xlUp)) End With With Me.ComboBox3 .ColumnCount = 2 .ColumnWidths = ";0" .List = d.Value End With Set r = Nothing Set n = Nothing Set d = Nothing TextBox3.Value = Worksheets(1).Range("A2").Value + 1 txtdate = Date OptionButton1.Value = True End Sub 'ComboBox1をクリックしたときの処理 Private Sub ComboBox1_Click() Worksheets(2).Select With Me.ComboBox1 Me.Label19.Caption = .List(.ListIndex, 1) Worksheets(2).Select Replace:=False End With End Sub 'ComboBox2をクリックしたときの処理 Private Sub ComboBox2_Click() Worksheets(3).Select With Me.ComboBox2 Me.Label20.Caption = .List(.ListIndex, 1) Worksheets(3).Select Replace:=False End With End Sub 'フォームからデータベースへの転記 Private Sub CommandButton3_Click() Dim Rowpos As Long Dim ColPos As Long Rowpos = Worksheets("柴田8月分").Range("a10000").End(xlUp).Row ColPos = 1 Rowpos = Rowpos + 1 With Worksheets("柴田8月分") .Cells(Rowpos, ColPos) = TextBox3.Value .Cells(Rowpos, ColPos + 1) = txtdate.Value .Cells(Rowpos, ColPos + 2) = Label19.Caption .Cells(Rowpos, ColPos + 3) = ComboBox1.Text .Cells(Rowpos, ColPos + 4) = ComboBox2.Text .Cells(Rowpos, ColPos + 5) = Label20.Caption .Cells(Rowpos, ColPos + 6) = ComboBox3.Text End With 'Noの加算 Dim i As Long For i = 1 To 1 Step 1 TextBox3.Value = TextBox3.Value + 1 Next Call Clearcmb End Sub 'データベース入力後にコンボボックスを空欄にする Private Sub Clearcmb() ComboBox1.Text = "" ComboBox2.Text = "" ComboBox3.Text = "" End Sub 'ユーザーフォームの終了 Private Sub CommandButton5_Click() Unload UserForm1 End End Sub 以上よろしくお願い申し上げます。使用機種はWindowsVistaで、 Excel2007です。私はVBA初心者です。
- ベストアンサー
- Visual Basic
- エクセル マクロ 教えてください。
sheet１に （a1=No. b1=月日 C1=項目 d1=収入 e1=支出 f1=摘要 G1=店名）項目を作りそれらをユーザーフォームを作り入力したいです。 この記述では上手く動けません。教えてください。 Private Sub CommandButton1_Click() Dim r As Long, 最終行 As Long, 項目行 As Long Dim re As String r = textboxs1.Value + 10 最終行 = Worksheets("入力").Range("B65536").End(xlUp).Row If r <= 最終行 Then re = MsgBox("訂正" & " " & "すでにデータが入力されています。" & Chr(13) & _ Chr(13) & "データを置き換えます。 本当に良いですか? ", _ Buttons:=vbYesNo + vbExclamation, Title:="注意!!") If re = vbYes Then With Worksheets("入力") .Cells(r, 2).Activate .Cells(r, 1).Value = TBox1.Value .Cells(r, 2).Value = TBox2.Value .Cells(r, 3).Value = ComboBox1.Value .Cells(r, 4).Value = TBox3.Value .Cells(r, 5).Value = TBox4.Value .Cells(r, 6).Value = TBox5.Value .Cells(r, 7).Value = ComboBox2.Value End With データクリア Exit Sub End If データクリア Exit Sub End If If r >= 最終行 + 1 Then r = 最終行 + 1 End If With Worksheets("入力") .Cells(r, 1).Value = TBox1.Value .Cells(r, 2).Value = TBox2.Value .Cells(r, 3).Value = ComboBox1.Value .Cells(r, 4).Value = TBox3.Value .Cells(r, 5).Value = TBox4.Value .Cells(r, 6).Value = TBox5.Value .Cells(r, 7).Value = CBomboox2.Value End With データクリア End Sub r = データNo + 10 With Worksheets("入力") .Activate .Cells(r, 2).Select TBox1.Value = .Cells(r, 1).Value TBox2.Value = .Cells(r, 2).Value ComboBox1.Value = .Cells(r, 3).Value TBox3.Value = Format(.Cells(r, 4).Value, "###,###") TBox4.Value = Format(.Cells(r, 5).Value, "###,###") TBox5.Value = .Cells(r, 6).Value ComboBox2.Value = .Cells(r, 7).Value End With Exit Sub End If If データNo > 最終行 - 10 Then データNo = 最終行 - 9 TBoxNo.Value = データNo データクリア End If End Sub
- ベストアンサー
- オフィス系ソフト
- マクロ FIND 検索方向の変更
いつも回答ありがとうございます。 FINDを使用した検索方向の変更についての質問です。以下のFINDの記述方法で、上から一発目に捉えられたキーワードではなく、下から一発目に捉えられたキーワードに変更するにはどうしたらよろしいでしょうか？それとも、FINDの記述方法を大幅に変えなければいけないのでしょうか？御指導の程宜しくお願い致します。 Sub TEST() Dim d As Integer Dim e As Integer Worksheets("一覧").Activate d = 3 e = 3 Do While Worksheets("一覧").Cells(d, 2).Value <> "" Dim c As Variant Dim R As Range Dim s As Range With Worksheets(Worksheets("一覧").Cells(d, 2).Value) Set c = .Columns("H").Find("増", , xlValues, 1) If Not c Is Nothing Then Set R = .Range(c.Offset(1, -4), .Cells(Rows.Count, "D").End(xlUp)) Set s = c.Offset(, -5) With Worksheets("編集用一覧") .Range(.Cells(e, 4), .Cells(e, 5)).ClearContents .Cells(e, 4).Value = s .Cells(e, 5).Value = Application.Sum(R) End With End If End With d = d + 1 e = e + 4 Loop End Sub
- ベストアンサー
- オフィス系ソフト
- EXCEL VBA 多種のコンボボックス操作
こんばんは。 現在ユーザーフォーム上に10個のコンボボックスを配置しています。 1-8は共通リストを、9と10は別々のリストを表示させたいのですが・・ Private Sub UserForm_Initialize() Dim X, No, Y As Integer With UserForm2 For No = 1 To 8 For X = 0 To 7 .Controls("ComboBox" & No).AddItem Worksheets("Letter").Cells(X + 1, 10).Value Next Next For Y = 0 To 7 .ComboBox9.AddItem Worksheets("Letter").Cells(Y + 1, 11).Value .ComboBox10.AddItem Worksheets("Letter").Cells(Y + 1,12).Value Next End With End Sub 上記のコードですが、エラーが出てどうにも行き詰っています。 Private Sub UserForm_Initialize() Dim X, No As Integer For No = 1 To 8 For X = 0 To 7 UserForm2.Controls("ComboBox" & No).AddItem Worksheets("Letter").Cells(X + 1, 10).Value Next Next End Sub ↑だと1-8まで問題なく動くのですが・・・ すみませんが、アドバイスお願いいたします。
- 締切済み
- オフィス系ソフト
- コンボボックスの値で参照するワークシートを変えたい
●質問の主旨 ComboBox3で選択した文字列によって、参照するワークシートを 変え、そのワークシートからComboBox4に代入するには、以下の コードをどのように書き換えればよいでしょうか？ ご教示願います。 ●質問の補足 添付画像でComboBox3に「営業」、「技術」、「総務」まで 入力することによってそれぞれ３つのワークシートを参照 させたいと考えています。 ・「営業」→中分類（営業）シート ・「技術」→中分類（技術）シート ・「総務」→中分類（総務）シート そして各シートにはそれぞれ異なった仕事内容の表が 既に作成されています。もしComboBox3で「営業」を 選択したなら、ComboBox4で中分類（営業）シートに 記載されている仕事内容を選択できるようにしたいと 考えています。 そのためSelect Caseステートメントを使って ComboBox3の内容によってComboBox4の内容を変える コードを作成したつもりです。 ●現在の問題点 １．下記のコードを実行しようとすると、 「実行時エラー91 オブジェクト変数またはWithブロック変数が設定されていません」 というエラーが返されます。 ２．デバックするとユーザーフォームではなく、 標準モジュールの2行目 UserForm1.Show が黄色くなります。 ●コード （標準モジュール） Sub 日報記入ダイアログ() UserForm1.Show End Sub （ユーザーフォーム） Option Explicit Private Sub ComboBox4_Change() End Sub 'ユーザーフォームの初期化 Private Sub UserForm_Initialize() Dim r As Range Dim n As Range Dim d As Range Dim t As Range With Worksheets(2) Set r = .Range("C3", .Cells(.Rows.Count, 2).End(xlUp)) End With With Me.ComboBox1 .ColumnCount = 2 .ColumnWidths = ";0" .List = r.Value End With With Worksheets(3) Set n = .Range("C3", .Cells(.Rows.Count, 2).End(xlUp)) End With With Me.ComboBox2 .ColumnCount = 2 .ColumnWidths = ";0" .List = n.Value End With With Worksheets(4) Set d = .Range("C3", .Cells(.Rows.Count, 2).End(xlUp)) End With With Me.ComboBox3 .ColumnCount = 2 .ColumnWidths = ";0" .List = d.Value End With '中分類のComboBox4は「大分類」の選択内容によって参照するワークシートが変わる Select Case t Case Is = ComboBox3("営業") With Worksheets(5) Set t = .Range("C3", .Cells(.Rows.Count, 2).End(xlUp)) End With With Me.ComboBox4 .ColumnCount = 2 .ColumnWidths = ";0" .List = t.Value End With Case Is = ComboBox3("技術") With Worksheets(6) Set t = .Range("C3", .Cells(.Rows.Count, 2).End(xlUp)) End With With Me.ComboBox4 .ColumnCount = 2 .ColumnWidths = ";0" .List = t.Value End With Case Is = ComboBox3("総務") With Worksheets(7) Set t = .Range("C3", .Cells(.Rows.Count, 2).End(xlUp)) End With With Me.ComboBox4 .ColumnCount = 2 .ColumnWidths = ";0" .List = t.Value End With End Select 'メモリの解放 Set r = Nothing Set n = Nothing Set d = Nothing Set t = Nothing 'その他の初期値 TextBox3.Value = Worksheets(1).Range("a10000").End(xlUp).Row txtdate = Date End Sub 'ComboBox1をクリックしたときの処理 Private Sub ComboBox1_Click() With Me.ComboBox1 Me.Label19.Caption = .List(.ListIndex, 1) End With End Sub 'ComboBox2をクリックしたときの処理 Private Sub ComboBox2_Click() With Me.ComboBox2 Me.Label20.Caption = .List(.ListIndex, 1) End With End Sub 'ComboBox2をクリックしたときの処理(中分類の仕事によってスターマークが変わる） 'フォームからデータベースへの転記 Private Sub CommandButton3_Click() Dim Rowpos As Long Dim ColPos As Long Rowpos = Worksheets(1).Range("a10000").End(xlUp).Row ColPos = 1 Rowpos = Rowpos + 1 With Worksheets(1) .Cells(Rowpos, ColPos) = TextBox3.Value .Cells(Rowpos, ColPos + 1) = txtdate.Value .Cells(Rowpos, ColPos + 2) = Label19.Caption .Cells(Rowpos, ColPos + 3) = ComboBox1.Text .Cells(Rowpos, ColPos + 4) = ComboBox2.Text .Cells(Rowpos, ColPos + 5) = Label20.Caption .Cells(Rowpos, ColPos + 6) = ComboBox3.Text End With 'Noの加算 TextBox3.Value = TextBox3.Value + 1 Call Clearcmb End Sub 'データベース入力後にコンボボックスを空欄にする Private Sub Clearcmb() ComboBox1.Text = "" ComboBox2.Text = "" ComboBox3.Text = "" End Sub 'ユーザーフォームの終了 Private Sub CommandButton5_Click() Unload UserForm1 End End Sub 以上よろしくお願い申し上げます。使用機種はWindowsVistaで、 Excel2007です。私はVBA初心者です。添付の画像でのユーザーフォームは プリントスクリーンでWorksheet(1)に貼り付けています。
- ベストアンサー
- Visual Basic
- コンボボックス or リストボックス （複数列表示→値の取得）
マクロ初心者です。（エクセル2003使用-ユーザーフォーム） 先日はお世話になり、ありがとうございました。 作成していくうちにさらに改良を加えたく、再質問させていただきます。 ※コンボボックス内の表示を複数行表示（Sheet1の管理番号,品名,注文数量）し、そのデータをSheet2のセルＡ（管理番号）,セルＢ（品名）,セルＣ（注文数量）と貼り付けようとしております。 が、本で探したところ複数行表示のやり方がリストボックスでしかのっていなく、さらに自分で作成したマクロでは動きませんでした。 すみませんが、お力をお貸しください。 （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 教えていただけましたら幸いです。 よろしくお願いいたします。
- ベストアンサー
- Visual Basic
- VBA コード番号がない場合は、次の行へ進む
ＯＳはＸＰPro、 Excelは2003を使用しています。 入金データの「支店データ」シートのコード番号がマスタの表にある時、新シート（test）にコピーするマクロを作ろうと悪戦苦闘しています。 下記までは組んだのですが、「インデックスが有効範囲にありません」とエラーになってしまいます。 マスタにないコードだからだと思っているのですが、そういう場合は次の行のコード番号に進めるステートメントをどう組めば良いか分かりません。 どなたかご教示頂けると有り難いです。 よろしくお願い致します。 Sub test() Dim wb As Workbook Dim ws As Worksheet Dim mypath As String Dim fname As String Dim maxgyo As Long 'マスタの最終行 Dim intRow As Long 'マスタの行 Dim strMasCode As Long 'マスタのコード番号 Dim maxgyo2 As Long '入金データの最終行 Dim intRow2 As Long '入金データの行 Dim strSrhCode As Long '入金データのコード番号 Dim shingyo As Long '新シートの書き込み行 Worksheets.Add After:=ActiveSheet, Count:=1 '新しいワークシートを作成 ActiveSheet.Name = "test" 'そのシートの名前は［test］ mypath = "C:\Documents and Settings\XXX\My Documents\XXX\" fname = "マスタ.xls" Set wb = Workbooks.Open(mypath & fname) '上記で指定したブックを開く Set ws = wb.Worksheets("担当マスタ") '［担当マスタ］シートを指定 Workbooks("入金データ").Activate maxgyo = Sheets("支店データ").Cells(Rows.Count, 1).End(xlUp).Row '支店データの最終行 For intRow = 2 To maxgyo strSrhCode = Worksheets("支店データ").Cells(intRow, 6) shingyo = 1 shingyo = singyo + 1 Workbooks("マスタ").Activate maxgyo2 = Sheets("マスタ").Cells(Rows.Count, 2).End(xlUp).Row 'マスタの最終行 For intRow2 = 2 To maxgyo2 strMasCode = Sheets("マスタ").Cells(intRow2, 2) 'マスタのコード番号を代入 If strSrhCode = strMasCode Then 'マスタと支店データのコード番号が一致したら With Workbooks("入金データ").Worksheets("test") .Cells(shingyo, 1) = Worksheets("支店データ").Cells(intRow, 1) .Cells(shingyo, 2) = Worksheets("支店データ").Cells(intRow, 2) End With End If Next intRow2 Next intRow End Sub
- ベストアンサー
- その他MS Office製品
- コンボボックスの項目と同じ項目をシートから削除する
よろしくお願いします Private Sub 追加_Click() Dim lRow As Long With Worksheets("開始").Cells(Rows.Count, "B").End(xlUp) .Offset(1).Value = Me.combobox1.Value End With End Sub combobox1.RowSource = B2:B200 上記でリストを作成していますが、 combobox1の項目を選んで、CommandButton1クリックしたら 同じ項目をシートのセル（B列）から選んで削除する その後、空白を詰める このようにできないでしょうか
- 締切済み
- その他（プログラミング・開発）
- Excel VBAのコンボボックス
お世話になります。 コンボボックス1と2と3は選択されますが コンボボックス4には何の表示もされません。 選択して条件設定は４つ以上できないのでしょうか？ Dim ITE As Variant Dim flg As Variant Private Sub ComboBox3_Change() 'ComboBox4セット Dim ico As Long ico = 1 With ThisWorkbook.Worksheets("data") KEY = Me.ComboBox1.Text KEY2 = Me.ComboBox2.Text KEY3 = Me.ComboBox3.Text Me.ComboBox4.Clear Do While .Cells(ico, 1) <> "" If .Cells(ico, 1) = KEY And .Cells(ico, 2) = KEY2 And .Cells(ico, 3) = KEY3 Then ITE = .Cells(ico, 4).Value flg = 0 For I = 0 To Me.ComboBox4.ListCount - 1 If ITE = Me.ComboBox4.List(I) Then flg = 1 Next If flg = 0 Then Me.ComboBox4.AddItem ITE End If ico = ico + 1 Loop End With Me.ComboBox4.SetFocus End Sub
- ベストアンサー
- その他（プログラミング・開発）
お礼
ほぼ、解決できました。有難うございました。 初歩的な問題がクリアされていない＞ご指摘のとおり1ヶ月程度の期間参考書やネットに落ちているソースコードを見ながら独学で試行錯誤しているだけなので基本を通過しているわけではありません。すぐに横着してしまうタイプなので、必要だとある程度分かっていても皆さんのように宣言をしっかりして全体の構造をイメージしてからというような作業を省いてしまっているところがありますが今回のことでその辺から反省してみようと思います。 戻り値、ApplicationMatchなど今後勉強する為にいろいろとキーワードまで提供していただき有難うございました。