Excel VBAテキストボックスを検索し、オーバーフローエラーが出る問題の解決方法

このQ&Aのポイント
  • Excel VBAのテキストボックスを使用して、数値を入力し、A列内に検索をかけるプログラムを組んだ。しかし、テキストボックスに6桁以上のデータを入力するとオーバーフローエラーが発生する問題が発生している。
  • この問題を解決するためには、テキストボックスの値をInteger型ではなく、Long型で宣言する必要がある。Long型はより大きな数値の範囲を扱うことができるため、6桁以上のデータでもエラーが発生しない。
  • 修正後のプログラムでは、Enterキーを押すたびにテキストボックスの値が検索され、A列内に一致する値があれば、それに対応するB列のセルに「みーつけた!」と入力される。
回答を見る
  • ベストアンサー

Excel VBA テキストボックスを検索

テキストボックス3に数値を入力し ExcelのA列にあるか検索をかける。 ある場合は、B列の同じ行に 「みーつけた!」と入力。 その設定で組んでみたのですが、 テキストボックス3にデータを6桁入力しようとすると 6桁目にオーバーフローエラーが出ます。 このプログラムの何処がおかしいのでしょうか? Private Sub TextBox3_Change() Dim Number As Integer If TextBox3.Value <> "" Then '空じゃない場合 Number = TextBox3.Value Call 検索(Number) MsgBox TextBox3.Value End If End Sub Sub 検索(ByVal Number As Variant) Dim FoundCell As Range Set FoundCell = Range("A:A").Cells.Find(What:=Number, lookat:=xlPart) If FoundCell Is Nothing Then Else FoundCell.Activate Range("O" & ActiveCell.Row).Value = "みーつけた!" End If End Sub

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

  • ベストアンサー
  • Picosoft
  • ベストアンサー率70% (274/391)
回答No.1

TextBox3_Change内で、Numberという変数をIntegerで宣言していますが、 Integerは-32,768 ~ 32,767の範囲の数字しか扱えません。 なので、この範囲外の数字を代入しようとするとオーバーフローエラーが発生します。 以下のページなどを参考にして、適切な型を使用してください。 http://excelvba.pc-users.net/fol5/5_2.html

satoron666
質問者

お礼

回答ありがとうございました! 直して上手く動くか、確認します。 ありがとうございました!

関連するQ&A

  • Excel VBA でテキストボックスの値をセルA列から検索

    いつもお世話になります。 Private Sub CommandButton3_Click() Dim 行 As String Dim 列 As String Dim 最終行 As String Dim 検索行 As String Dim メッセージ As Integer Dim 一致 As Range Dim myNO As Variant Dim i As Long Sheets(3).Select 最終行 = Range("A2").End(xlDown).Offset(1).Select 行 = ActiveCell.Row 列 = ActiveCell.Column myNO = TextBox2.Value 検索行 = Range("A2").End(xlDown).Select ※・・・Set 一致 = Range("A2:検索検").Findwhat:=TextBox2,lookat:=xlWhole) If 一致 Is Nothing Then MsgBox "データがありません。新規コード入力します。" Cells(行, 列 + 0) = UserForm1.TextBox2.Value Cells(行, 列 + 1) = UserForm1.ComboBox7.Value Else i = Cells(行 - 1, "A") Cells(i, 列 + 0) = UserForm1.TextBox2.Value Cells(i, 列 + 1) = UserForm1.ComboBox7.Value End If End Sub 「エラー1004'Range'メソッドは失敗しました'Global'オブジェクト」とでます。※印が黄色になっています。 ユーザーフォーム1のテキストボックスの値をシート3のA列から検索して、一致すれば、A列の一致セルに上書き入力して、一致が無い場合はA列の空白セルに追加入力したいのです。よろしくお願い致します。

  • VBAで複数検索、AdvancedFilter

    AdvancedFilterを使って、検索を行っているのですが、応答なしと固まってしまったり、動作が重くなったりするのですが、原因わかりますでしょうか? 3000行くらいなのですが、ユーザーフォームを立ち上げて、検索、結果を見て、また検索をしようとすると固まったりして動かなくなって強制終了になる場合があります。 軽くなる方法はありますか? Private Sub CommandButton1_Click() Worksheets("商品マスタ").Activate If ActiveSheet.FilterMode Then ActiveSheet.ShowAllData ActiveWindow.ScrollRow = 3 Range("S1:AA4").ClearContents Range("S1:AA4").NumberFormatLocal = "@" Range("T2:U2").Value = Range("B2:C2").Value Range("V2:X2").Value = Range("D2").Value Range("Y2:Z2").Value = Range("E2:F2").Value Range("AA2").Value = Range("G2").Value If Me.TextBox1.Value <> "" Then ' コード Range("U3").Value = "*" & Me.TextBox1.Value End If If Me.TextBox2.Value <> "" Then ' メーカー Range("V3").Value = "*" & Me.TextBox2.Value & "*" End If If Me.TextBox3.Value <> "" Then ' シリーズ Range("W3").Value = "*" & Me.TextBox3.Value & "*" End If If Me.TextBox4.Value <> "" Then ' サイズ Range("W3").Value = "*" & Me.TextBox4.Value & "*" End If If Me.TextBox5.Value <> "" Then ' 入荷日 Range("T3").Value = Me.TextBox5.Value End If If Me.TextBox9.Value <> "" Then ' 仕入れ先 Range("Z3").Value = Me.TextBox9.Value End If If Me.TextBox12.Value <> "" Then ' 単体価格 Range("AA3").Value = Me.TextBox12.Value End If If Me.TextBox6.Value <> "" Then ' 在庫数 Range("Y3").Value = Me.TextBox6.Value End If If Cells(3, Columns.Count).End(xlToLeft).Column > 19 Then Range("A2:G" & Rows.Count).AdvancedFilter Action:=xlFilterInPlace, _ CriteriaRange:=Range("S2").CurrentRegion, Unique:=False End If Range("S1:AA4").ClearContents ActiveWindow.ScrollColumn = 4 Range("A2").Activate End Sub Private Sub CommandButton2_Click() Unload Me 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 とりあえず検索はできるのですが、使用されていない文字や記号を入力したあとにバックスペースキーで入力した文字や記号を削除するとリストボックスの内容が意図した内容で表示されません。 どこを修正したらいいでしょうか。

  • ExcelVBAで行と列の検索

       A  B  C  D  E 1  コード あ  い  う  え 2  10  ○    ○ 3  20     ○  ○ 4  30          ○ 上記の表が5000件あります。Textbox1に入力し検索ボタンを押すと A列のコードを検索して一致する列の○のあるところの1行目の項目 をtextbox2に表示したいのですがうまく行きません。 よろしくお願い致します。 Private Sub CommandButton1_Click() '検索フォームボタン Dim i As Long Dim 最終行 As String Dim サーチ行 As Long Sheets(1).Activate 最終行 = Range("A1").End(xlDown).Row サーチ行 = 0 For i = 2 To 最終行 If TextBox1.Value = Range("A" & i) Then If Range("B" & i, "N" & i) = "" Then TextBox2.Text = Range("B1", "N1") サーチ行 = i Exit For End If End If Next If サーチ行 = 0 Then MsgBox TextBox1.Value & "データはありません。", vbInformation, "無し" End If TextBox1.SetFocus End Sub エラーはでません。データはありませんとなります。  

  • excelのテキストボックスで、うまく動作しない

    a列に行間隔不等で1~100の数字を記入してあります。 このセル番地を検索する為、テキストボックスで、以下の記述を試しましたが、うまくいきません。 1、lostfocusに設定すると、 テキストボックス入力後、エンターキーを押してもフォーカスが移動しない。 2、changeに設定すると、 2桁数字を入力できない。(1数字だけでフォーカスが移動してしまう) 設定の不備な点、 あるいは、規定の検索メニュウ使用以外で、 最適の方法を教えてください。 Private Sub TextBox1_Change() Dim dx dx = Application.WorksheetFunction.Asc(TextBox1.Value) With ActiveSheet.Range("a:a") Set c = .Find(dx, LookIn:=xlValues) If Not c Is Nothing Then c.Activate Else MsgBox "該当なし" End If End With TextBox1.Value = "" 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を使った物を参考にしています。

  • エクセル マクロ 同じ数値のセルを検索

    教えてください。 sheet2のG1に3と入力しマクロを実行すると、sheet1のA列(通し番号)の3~5の行をコピーして、sheet2のA2にペーストしたいと思ってます。 (sheet1) 番号 数値1 数値2 数値3 数値4   1     5   10   15   20   2    10   15   20   25   3     5   15   20   20   4    10   20   15   25   5     10   15   20   20 ・    ・    ・    ・    ・ ・    ・    ・    ・    ・            ↓ (sheet2) 番号 数値1 数値2 数値3 数値4      3   3    5   15   20    20   4   10   20   15    25   5   10   15   20    20 イメージとしては上の通りです。 まずは、同じsheet1のG1に3を入力して、A列の3(A4)を検索することを目標にしましたが、ここの時点でこけてしまいました。。 Sub 同じ数値のセルを検索() Dim 番号 As String Dim FoundCell As Range Range("A1").Select 番号 = "G1" Set FoundCell = Cells.Find(What:="番号") If FoundCell Is Nothing = False Then FoundCell.Select End If End Sub 笑われると思いますが、これではダメでした。 どうかお助けしていただけないでしょうか。

  • エクセル2010、VBAや関数について

    Private Sub CommandButton1_Click() Worksheets("商品マスタ").Activate Application.Calculation = xlCalculationManual If ActiveSheet.FilterMode Then ActiveSheet.ShowAllData ActiveWindow.ScrollRow = 3 Range("AI1:AQ4").ClearContents Range("AI1:AQ4").NumberFormatLocal = "@" Range("AJ2:AK2").Value = Range("B2:C2").Value Range("AL2:AM2").Value = Range("D2").Value Range("AO2").Value = Range("E2").Value Range("AP2").Value = Range("V2").Value Range("AQ2").Value = Range("W2").Value Range("AN2").Value = Range("D2").Value If Me.TextBox1.Value <> "" Then ' コード Range("AK3").Value = "*" & Me.TextBox1.Value End If If Me.TextBox2.Value <> "" Then ' メーカー Range("AL3").Value = "*" & Me.TextBox2.Value & "*" End If If Me.TextBox3.Value <> "" Then ' <--シリーズ Range("AM3").Value = "*" & Me.TextBox3.Value & "*" End If If Me.TextBox4.Value <> "" Then ' <--サイズ Range("AN3").Value = "*" & Me.TextBox4.Value & "*" End If If Me.TextBox5.Value <> "" Then ' 入荷日 Range("AJ3").Value = Me.TextBox5.Value End If If Me.TextBox9.Value <> "" Then ' 仕入れ先 Range("AP3").Value = Me.TextBox9.Value End If If Me.TextBox12.Value <> "" Then ' 単体価格 Range("AQ3").Value = Me.TextBox12.Value End If If Me.TextBox6.Value <> "" Then ' 在庫数 Range("AO3").Value = Me.TextBox6.Value End If If Cells(3, Columns.Count).End(xlToLeft).Column > 34 Then Range("A2:W" & Rows.Count).AdvancedFilter Action:=xlFilterInPlace, _ CriteriaRange:=Range("AI2").CurrentRegion, Unique:=False End If Range("AI1:AQ4").ClearContents ActiveWindow.ScrollColumn = 4 Range("A2").Activate Application.Calculation = xlCalculationAutomatic End Sub このようなマクロを組んでいるのですが、とても反応が遅いのですが、 シートにはA4-AG2000にデータが入っていて、 G4-U2000には =SUMIFS('[在庫.xlsx]02'!$AD:$AD,'[在庫.xlsx]02'!$AQ:$AQ,$A421,'[在庫.xlsx]02'!$AS:$AS,$F$2,'[在庫.xlsx]02'!$AT:$AT,G$2) このような関数が入っております。 これが原因で、動作が遅くなっているのでしょうか? 行の挿入等もとても遅いのですが、 G-U列の関数をやめてVBAで転記してから、検索をかけたら、早くなるのでしょうか? G-U列には関数での表記しかわからなかったため、関数をいれております。 解決法があれば教えてください。

  • エクセルマクロ_テキストボックスをシートに反映(その2)

    エクセルマクロ初心者です。(2003使用_ユーザーフォーム) 先ほどは大変お世話になりました。 複数行に応用させようとしたのですが、管理番号が余計に記載(テキストボックス(出荷日など)が空欄であっても、管理番号だけはとられてしまいます)されてしまいます。すみませんが、ご教授よろしくお願いいたします。 リストボックス1のデータは、Sheet1を表示しています。→管理番号はSheet2のA最終行に記載されます。 テキストボックス1(回答日)は、上記の管理番号記載のとなりに、 テキストボックス2(出荷日)は、テキストボックス1記載のとなりに、 ・・・とテキストボックス4(コメント)(これはK列)に1行で記載されます。 ↑ここまでは、教えていただいたので、完璧なのですが、 テキストボックス2~4までの内容を、あと複数行(4件)追加できるように試してみたのですが、空欄であっても管理番号だけは常に記載されてしまいます。 テキストボックス2と5に記載されている場合は、Sheet2に値を反映させるが、空欄の場合は、値を反映させないようにしたいのです。 (Sheet1=データベース) C5   D5 管理番号 品名 アカ12 りんご アオ56 みかん クロ34 なし クロ89 すいか アオ12 もも (Sheet2=入力シート) A(管理番号)    B(回答日)    C(出荷日)   D(数量)     K(コメント) アオ56        8月9日        8月10日      75     送り先の確認 アオ56                    8月11日      80 クロ34        9月4日        9月5日      80 (今回は、2行で作成した場合のマクロを記載しました) Private Sub UserForm_Initialize() With ListBox1 .ColumnWidths = "0;0;50;50" .ColumnCount = 4 .RowSource = "Sheet1!A5:D" & Worksheets("Sheet1").Range("C" & Rows.Count).End(xlUp).Row End With End Sub Private Sub CommandButton1_Click() If TextBox2.Value Then Dim lRow As Long With Worksheets("Sheet2") lRow = .Range("A" & Rows.Count).End(xlUp).Row .Range("A" & lRow + 1).Value = ListBox1.List(ListBox1.ListIndex, 2) If IsDate(TextBox1.Value) Then .Range("B" & lRow + 1).Value = TextBox1.Value End If If IsDate(TextBox2.Value) Then .Range("C" & lRow + 1).Value = TextBox2.Value End If If IsNumeric(TextBox3.Value) Then .Range("D" & lRow + 1).Value = TextBox3.Value End If .Range("K" & lRow + 1).Value = TextBox4.Value End With End If If TextBox5.Value Then Dim llRow As Long With Worksheets("Sheet2") llRow = .Range("A" & Rows.Count).End(xlUp).Row .Range("A" & llRow + 1).Value = ListBox1.List(ListBox1.ListIndex, 2) If IsDate(TextBox5.Value) Then .Range("C" & llRow + 1).Value = TextBox5.Value End If If IsNumeric(TextBox6.Value) Then .Range("D" & llRow + 1).Value = TextBox6.Value End If .Range("K" & llRow + 1).Value = TextBox7.Value End With End If Dim myCtrl As Control For Each myCtrl In Controls If TypeName(myCtrl) = "TextBox" Then myCtrl.Value = vbNullString End If Next End Sub (ユーザーフォーム) リストボックス1=Sheet1のデータを反映 テキストボックス1(回答日) テキストボックス2(出荷日),テキストボックス3(数量),テキストボックス4(コメント)←1件目 テキストボックス5(出荷日),テキストボックス6(数量),テキストボックス7(コメント)←2件目 ↑1件目のみでコマンドボタンを押した場合は、1件目のみの管理番号取得をしたいのです。が今は、2件目が空欄でも管理番号はとられてしまいます。 長くなってしまいすみません。 どなたかご回答いただければ幸いです。よろしくお願いいたします。

  • Excel vba 一度で全角・半角の文字を検索

    Excel vbaの初心者ですが、他のサイトを参考にして 以下のプログラムを作成しました。 指定された文字をシートから削除する物です。 「FindDelete」の中で、一度で全角・半角の文字を検索する方法があれば 教えてください。よろしくお願いします。 Sub FindDelete(ss As String) Dim FoundCell As Range Dim FirstCell As Range Dim Target As Range Dim c As Range Dim findArea As Range Set findArea = Intersect(Columns("E:F"), ActiveSheet.UsedRange) Set FoundCell = findArea.Find(What:=ss, LookAt:=xlPart) If FoundCell Is Nothing Then MsgBox ss & "は見つかりません" Exit Sub Else Set FirstCell = FoundCell Set Target = FoundCell End If Do Set FoundCell = findArea.FindNext(FoundCell) If FoundCell.Address = FirstCell.Address Then Exit Do Else Set Target = Union(Target, FoundCell) End If Loop Target.Select If MsgBox(ss & ":" & vbCrLf & Target.Count & "件見つかりました", vbYesNo, "削除しますか?") = vbYes Then For Each c In Target c = Replace(c, ss, "") Next c End If End Sub Sub tFindDelete() Dim ss As String ss = "カブシキガイシャ" ss = StrConv(ss, vbNarrow) FindDelete (ss) ss = StrConv(ss, vbWide) FindDelete (ss) ss = "ユウゲンガイシャ" ss = StrConv(ss, vbNarrow) FindDelete (ss) ss = StrConv(ss, vbWide) FindDelete (ss) End Sub

専門家に質問してみよう