Excel VBAでの特定シートの発注日の検索に関する質問

このQ&Aのポイント
  • Excel VBAを使用して特定のシート内で発注日を検索する方法について質問があります。
  • 特定のシートで発注日をリスト表示するマクロを組むことがうまくいかないため、解決策を求めています。
  • すでに似たようなマクロ関連の質問を投稿していますが、初歩的な質問が多く申し訳ありません。
回答を見る
  • ベストアンサー

EXCEL VBAについて質問です

最近EXCELのマクロを組む勉強を始めました。 幾つかわからないことがあるので、教えてください。 お店の在庫と売上を管理するシートを作成しています。 その管理表では年度ごとにシートを分けています。 調べたいのは、今回注文を受けた会社から過去に注文を受けたことがあるか、受けたことがあれば何年度の何月に受けたか、という内容です。 具体的には「注文者」の名前で検索して、発注日をリストで表示させたいと考えています。 例) A株式会社から商品の注文を受けた 2015年度~2019年の5枚のシートで「A株式会社」を検索し、発注された日を確認したい。 エクセルにもともと備わっている検索機能を使ってもよいのですが、一番知りたいのは「過去にいつ発注されたか」です。本来の検索機能では発注日をリスト表示できません。 各シートのフォーマットはそろっていて、会社名の左隣に発注日が入力されています。※会社名が入力されているのは各シートのC列です。 まずは特定のシートで計算してリストに表示させるマクロを組み、 それがうまくいったらワークシートのインデックス番号を変数としてFor文でループさせてみよう…と考えたのですが、 そもそも特定のシートでもうまくいきませんでした。(列を範囲指定して検索しているはずなのに、そのシート上すべてで検索されてしまう。たとえばE列=備考欄にA株式会社という名前が入っていると、そのセルもリストに表示されてしまう。) これ以上は自分だけで考えていてもうまい方法が思いつかないので、お知恵をお貸しいただけると幸いです。 (似たようなマクロ関連の質問をいくつか投稿しておりますが、初歩的な質問ばかりで申し訳ありません) Sub 検索() Dim FoundCell As Variant Dim FirstCell As Variant Dim mRange As Range Dim keyword As Variant Set mRange = Worksheets("2019年度").Range("C1:C100") keyword = Application.InputBox("調べたい会社名を入力してください") Set FoundCell = mRange.Find(What:=keyword, SearchOrder:=xlByRows) If FoundCell Is Nothing Then MsgBox "過去に発注を受けた履歴がありません" Exit Sub Else Set FirstCell = FoundCell UserForm1.ListBox1.AddItem FoundCell.Address & vbTab & FoundCell.Value & vbTab & FoundCell.Offset(0, 1).Value End If Do Set FoundCell = Cells.FindNext(FoundCell) If FoundCell.Address = FirstCell.Address Then Exit Do Else UserForm1.ListBox1.AddItem FoundCell.Offset(0, -1).Value & FoundCell.Address & vbTab & FoundCell.Value End If Loop UserForm1.Show vbModeless End Sub

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

  • ベストアンサー
  • kkkkkm
  • ベストアンサー率65% (1618/2457)
回答No.1

> Set FoundCell = Cells.FindNext(FoundCell) Set FoundCell = mRange.FindNext(FoundCell) ではないでしょうか。 Cellsはすべてのセルになります。

vvba321
質問者

補足

>kkkkkmさん ご指摘の部分を修正したらすぐに解決しました…きちんと理解していないので基礎的なところを見落としてしまうのですね…ありがとうございました! ちなみにもしお分かりでしたらお教えいただきたいのですが、これと同じ検索を複数シートで同時に行う場合は、ワークシートのインデックス番号を変数iとして、for文で繰り返し計算させれば実行できるのでしょうか?

その他の回答 (2)

  • imogasi
  • ベストアンサー率27% (4737/17068)
回答No.3

何を質問しているのかな? 文章で、聞きたいことを、箇条書きしたら。 希望は掲示したコードの添削ですか? 質問文章は長いが、主題がぼやけている。 ーー 小生の経験から、Find関連は、学習の苦労が多いテーマだが、そのボヤキと主題が混じって、聞きたいことが、わかりにくい。 Find、FindNextはRangeセル範囲に関しての検索なので、>「=備考欄の文字該当分も含まれる」というのはどうかな。 ーー 小生が、むつかしい(簡単な方法がない)と思うのは、年度ごとに(データ)シート(ブック?)を分けている点です。しかし分けるのも自然だとおもうが。 ーー それも繰り返し処理でも良いとして、やるなら、(For Each  ・・Next)泥臭いが簡単です。 ただ処理時間がかかるような気がします。泥臭いので個人の好みではない点だけです。 Findメソッド以外に良い方法がない。 1つのシートを検索する(条件該当分はすべて拾う)のコード例は、「VBA Find」でWEB照会すれば、たくさん記事がある。  ややこしいとは思うが、まあ慣れでしょう。 アクセスにエクセルにある過去データをエクスポートしておいて、Select文でやれば速いかな。 ーー 参考・確認 WEB記事のコードを使って 下記で、範囲外セル(Range("A1:C8")外)に、「土屋」を入れて検索すると、出てこなかったが。 Sub macro3() Dim myRange As Range Dim myObj As Range Dim keyWord As String Set myRange = Range("A1:C8") keyWord = "土屋" Set myObj = myRange.Find(keyWord, LookAt:=xlPart) If myObj Is Nothing Then MsgBox "'" & keyWord & "'はありませんでした" Exit Sub End If Dim msg As String Dim myCell As Range Set myCell = myObj Do msg = msg & "'" & keyWord & "'は" & myCell.Row & "行目" & myCell.Column & " にあります" & vbCrLf Set myCell = myRange.FindNext(myCell) Loop While myCell.Row <> myObj.Row MsgBox msg End Sub ーー Set myRange = Range("B:B")とするとA列の土屋は拾わなかった。

vvba321
質問者

お礼

imogasiさん、回答ありがとうございます。 まずは自分の文章が要点を得ておらず申し訳ありません。 コードの添削をいただいたうえで、より良いやり方があればお教えいただきたいという趣旨でした。 時間と手間がかかってもよければ大抵のことはifとfor文で解決できるんですよね。 でも、vbaをきちんと勉強するつもりならそれ以外のことも学んでいかなければ……と思い、今回findを使って過去の注文履歴を表示させる練習をしたのですが、基礎がわかっていないことを痛感させられました。 今回は先に回答をくださった方がいたのでそちらの方をベストアンサーに選ばせていただきましたが、丁寧にご指摘いただきありがとうございました!

  • kkkkkm
  • ベストアンサー率65% (1618/2457)
回答No.2

> ワークシートのインデックス番号を変数iとして、for文で繰り返し計算させれば実行できるのでしょうか? いけると思います。 ループごとの最後に For i = 1 To Sheets.Count 処理 Set mRange = Nothing Next みたいにオブジェクトの開放を入れておいた方が無難だと思います。

vvba321
質問者

お礼

kkkkkmさん、重ね重ねありがとうございます! 最初にご指摘いただいた点を修正し、for文を入れたらうまくいきました!

関連するQ&A

  • 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で指定したとおりの間隔で表示させたいと思っています。 どうか助言をお願いいたします。

  • VBAを使って検索をしたい

    VBAを使って検索をしたい EXCEL2007を使っております。 フォームを立ち上げて日付を入れるとシートの検索を行い、リスト内にその日付のA~Gまでのセルの内容が表示され、それらを別シートに貼り付けるといったことをしたいのですが、複数のセルの情報をリスト内に表示をするのが、よくわからず教えていただきたく思います。 フォーム内のテキストボックスに検索する日付を入れると 画像でいうところのA列を検索し、その日付内のA~Gをリストに表示して、ボタンを押すと貼り付けるといった、動きにしたいのですが、お願いします。 現状検索BOXに以下の記述をしてます これでは、A列のものだけが出てきます。お助けください。 ************************* Private Sub TextBox1_Change() Dim r As Range, FirstCell As Range, rng As Range Dim vnt As Variant Dim prow As Long Dim s As Worksheet Dim cnt As Long Set s = Sheets("sheet2") Set rng = Intersect(s.Range("a:a"), s.UsedRange) '検索キー Set r = rng.Find(What:=TextBox1.Text) If r Is Nothing Then MsgBox "見つかりませんよ" GoTo Exit_sub End If Set FirstCell = r ReDim vnt(0) vnt(0) = s.Cells(r.Row, 1).Resize(1, 5).Value '検索位置 prow = r.Row cnt = 1 Do Set r = rng.FindNext(r) If Not r Is Nothing And (r.Address <> FirstCell.Address) _ And (FirstCell.Row <> r.Row) And (prow <> r.Row) Then ReDim Preserve vnt(UBound(vnt) + 1) vnt(UBound(vnt)) = s.Cells(r.Row, 1).Resize(1, 5).Value '検索位置 prow = r.Row cnt = cnt + 1 End If Loop While r.Address <> FirstCell.Address ' If cnt = 1 Then vnt = s.Cells(FirstCell.Row, 1).Resize(1, 5).Value '検索位置 If cnt > 1 Then vnt = Application.Transpose(Application.Transpose(vnt)) ListBox1.List = vnt ' Set FirstCell = Nothing Erase vnt Exit_sub: If cnt = 0 Then ListBox1.Clear Set r = Nothing Set rng = Nothing Set s = Nothing End Sub

  • 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

  • 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

  • Excel VBA ユーザフォームの検索について

    添付の画像のようなユーザフォームを作っています。 TextBox1に検索ワードを入力して、CommandButton1をクリックすると、下のComboBox1に一覧が出るようにしたいと思い、ほかのサイトから下記のコードを見つけて、作ってみました。参照先のsheet2を表示しているときは大丈夫なのですが、別のシートを選んでいるとエラーになります。 sheetは3つあり、それぞれ違うリストが入力されています。今回はsheet2のリストを参照したいのですが、最初はsheet1が表示されている状態で実行したいです。 エラーの内容は 実行時エラー9 インデックスが有効範囲にありません。 コチラがコードです。 Private Sub UserForm_Initialize() Dim i As Long, imax As Long Dim tbl() As Variant imax = ThisWorkbook.Worksheets("sheet2").Cells(Rows.Count, "A").End(xlUp).Row ReDim tbl(imax) For i = 1 To imax tbl(i) = Range("A" & i).Value Next i With ComboBox1 .List() = tbl() End With End Sub Private Sub CommandButton1_Click() Dim i As Long, imax As Long Dim tbl() As Variant Dim cnt As Long, j As Long j = -1 With ThisWorkbook.Worksheets("sheet2") imax = .Cells(Rows.Count, "A").End(xlUp).Row cnt = Application.CountIf(Range("A1:A" & imax), "*" & TextBox1.Text & "*") ReDim tbl(cnt) For i = 1 To imax If InStr(.Range("A" & i), TextBox1.Text) > 0 Then j = j + 1 tbl(j) = Range("A" & i).Value ←この部分がエラーになる End If Next i End With With ComboBox1 .List() = tbl() End With End Sub どこを直せば良いか、教えてください。 よろしくお願いします。

  • 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列の空白セルに追加入力したいのです。よろしくお願い致します。

  • EXCEL VBAの配列でわかりません。

    こんなコードがあるのですが、最後の他のシート(作業中シート)に書き込もうとするとエラーになってしまいます。”Sheets("作業中").”を抜くと同じシートに結果は返ってくるのですが…。コードの内容は、ある範囲のある列から空白ではないセルを探し出してその行のデータを配列で汲み取り、他のシートに一括で洗い出すというものです。 Sub 作業中() Dim myRow As Long Dim Data As Variant Dim WC() As Variant Dim WCE() As Variant myRow = Range("H1").CurrentRegion.Rows.Count Data = Range("H1:M" & myRow).Value For i = 1 To myRow If Data(i, 5) <> "" Then a = a + 1 Else b = b + 1 End If Next ReDim WC(a) ReDim WCE(b) c = 0 d = 0 For i = 1 To myRow If Data(i, 5) <> "" Then WC(c) = Range("H" & i & ":K" & i).Value c = c + 1 Else WCE(d) = Range(Cells(i, 8), Cells(i, 11)).Value d = d + 1 End If Next For i = 0 To a Range(Cells(i + 1, 15), Cells(i + 1, 18)).Value = WC(i) Next For i = 0 To b Range(Cells(i + 1, 19), Cells(i + 1, 22)).Value = WCE(i) Next e = Range(Cells(1, 15), Cells(a, 18)).Value Sheets("作業中").Range(Cells(1, 1), Cells(a, 4)).Value = e End Sub ちなみに同じシートから↓のコードを実行するとうまくいきます。 なぜ~??わからな~い??おしえてくださーい!! Sub test() Dim a As Variant a = Range("H1:K4") Sheets("作業中").Range("N1:Q4") = a End Sub

  • エクセル VBAラベル 表示?

    宜しくお願いいたします。 エクセル2000にて Private Sub UserForm_Initialize() Dim TYU As Integer Dim TYUB As Integer For TYU = 3 To 100 If Worksheets("発注履歴").Cells(TYU, 1) = "" Then TYUB = Right(Worksheets("発注履歴").Cells(TYU - 1, 1).Value, 3) Label1.Caption = Format(Date, "yy") & TYUB + 1 Exit For End If Next TYU End sub 上記のようにコードを書き込みました。 ワークシート発注履歴("A3")には注文番号090001が 入力されております。 次回発注時、入力フォームを開いたときに ラベル1に090002を表示しようとしたのですが 092と表示されてしまい 2 のまえの00を表示できません。 どの様に修正すれば宜しいでしょうか?

  • Excel VBA Findで日付だけのセルが検索できない

    日付のセルを検索するために、以下のような処理をさせていますが、日付だけのセルが検索できません。  【例】(1)は検索できますが、(2)が検索されません。    (1) 2010/03/05が誕生日    (2) 2010/03/05    (※(1)、(2)共に検索できるようにしたいと思っています。) Dim FoundCell as Variant Dim search_words as String search_words = "20??/*/" Set FoundCell = Cells.Find(what:=search_words,After:=ActiveCell, LookIn:=xlValues, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False, MatchByte:=False) ※Excel2003を使用しています。

  • エクセルVBAコンボボックスについて

    リスト欄のセルA3から下方向に大分類(A16まで14種類)があります。 コンボボックス1に大分類をリスト化して選べるようにしたいと思っています。 しかし、(1)のようにVBAを記入して、マクロを実行すると、コンボボックス1には、 大分類で14個あるリストの4つしか出てきません。 -(1)(抜粋)--------------------------------------------------------- Private Sub UserForm_Initialize() Dim MyVar1 As Variant MyVar1 = Sheets("リスト").Range("A3:A" & Range("A3").End(xlDown).Row) ------------------------------------------------------------------ (2)のように記述してマクロを実行すると、コンボボックス1には、14個全てが表示されます。 -(2)(抜粋)--------------------------------------------------------- Private Sub UserForm_Initialize() Dim MyVar1 As Variant MyVar1 = Sheets("リスト").Range("A3:A16") ------------------------------------------------------------------ 原因がわかる方、いらっしゃいませんか? 出来れば、リスト欄のA列は14個よりも増える可能性があるので、Range("A3:A" & Range("A3") .End(xlDown).Row)のような範囲の指定がしたいです。 なお、リストシートのA3を選択して、「Ctrl+↓」でA16が選択されました。

専門家に質問してみよう