• ベストアンサー

【Find関数】あるのに見つからない。

現在、VBAで、 Find関数で行う処理を記述しています。 以下、記述------------------------ Dim LastRow, onecell As String Dim OrderNew As String LastRow = Range("B38").End(xlDown).Row oldad = 38 For cnt = 38 To LastRow OrderNo = Range("D" & oldad).Value Range("K" & cnt).Value = Range("B" & oldad).Value Range("M" & cnt).Value = Range("C" & oldad).Value Range("N" & cnt).Value = Range("D" & oldad).Value Range("O" & cnt).Value = Range("E" & oldad).Value Range("P" & cnt).Value = Range("F" & oldad).Value Range("P" & cnt).Value = Range("G" & oldad).Value Range("Q" & cnt).Value = Range("H" & oldad).Value Set OrderNoResult = Range("D" & 38 & ":D" & LastRow).Find   (OrderNo, MatchByte:=False, MatchCase:=False,          LookIn:=xlValues, Lookat:=xlWhole, SearchOrder:=xlByRows) OrderResultValue = OrderNoResult.Value Do While OrderNoResult.Value = OrderResultValue       oldad = OrderNoResult.Row Set OrderNoResult = Range("D" & 38 & ":D" &LastRow).FindNext(OrderNoResult) If OrderNoResult Is Nothing Then Exit Do End If Loop Range("L" & cnt).Value = Range("B" & oldad).Value Range("R" & cnt).Value = Range("I" & oldad).Value oldad = oldad + 1 Next cnt 終わり---------------------------- 30週目で必ず止まります。値はあります。Ctrl+Fで同じ値をペーストして、実行して該当したので間違いありません。 また、一度停止し、再度実行すると、その一周は動き、また停止します。これを一回ずつ繰り返す場合は、問題なく処理されます。 オブジェクトの初期化のような処理が必要なのでしょうか? ご教授お願いいたします。

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

  • ベストアンサー
  • hige_082
  • ベストアンサー率50% (379/747)
回答No.2

根本的に Find の使用の仕方が間違ってると思います 下記で代用できませんか Dim LastRow As String Dim OrderNew As String '最終行を取得 LastRow = Range("B38").End(xlDown).Row oldad = 38 '最終行になるまでループ For cnt = 38 To LastRow '初期値セット(値が詰められている最初の行)。一週目は'1' OrderNo = Range("D" & oldad).Value 'ヘッダーをセット。 Range("K" & cnt).Value = Range("B" & oldad).Value Range("M" & cnt).Value = Range("C" & oldad).Value Range("N" & cnt).Value = Range("D" & oldad).Value Range("O" & cnt).Value = Range("E" & oldad).Value Range("P" & cnt).Value = Range("F" & oldad).Value Range("P" & cnt).Value = Range("G" & oldad).Value Range("Q" & cnt).Value = Range("H" & oldad).Value 'D列の注文番号を検索。Rangeオブジェクトを格納。 'Rangeオブジェクトから値を格納。 OrderResultValue = Range("D" & oldad).Value 'ループ。比較。検索される値が見つからなくなったらその行番号を取得し、 _ IF文によりループエンド。その際、次の検索開始位置をoldadで確保。 Do While Range("D" & oldad + 1).Value = OrderResultValue oldad = oldad + 1 Loop Range("L" & cnt).Value = Range("B" & oldad).Value Range("R" & cnt).Value = Range("I" & oldad).Value '決済行の次行が、新たな発注番号のため、oldad+1で次行取得。 oldad = oldad + 1 Next cnt 試してみてください

satoc
質問者

お礼

解決しました。 私のやりたい処理は、そもそもループで拾える処理だったんですね・・・・。 私があまりに短絡的な発想をしていたみたいで恐縮です。 非常に助かりました。 ありがとうございます。

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

その他の回答 (1)

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

こんな複雑なコードを質問にコピーし、エラーを考えてくれていうのは無茶だ。 コードを読み解くことまで読者に放り投げている。 全体的なエクセルでの処理・データの成り立ち・したいことを文章で説明すること。 プログラムでやっている処理など文章ででも説明を添えたら。 >Range("K" & cnt).Value = Range("B" & oldad).Value でCntは38から最下行まで変化させているが、右辺のoldad = 38は38で固定している。処理内容がFindならなぜ繰り返すのか一見して判らなかった。 >30週目で 週は表上ではどう変化するのか?週が変わるとデータの列が変わるのか? 突然出てきて判らない。読者・回答者に配慮した質問をしてほしい。 作った自分だけが判ることでは困る。 例えばFind("g")は私の勝手な例ですが Sub test02() LastRow = Range("B38").End(xlDown).Row OrderNoResult = Range("D" & 38 & ":D" & LastRow).Find("g") MsgBox OrderNoResult End Sub では、初発見のセルの「値」しか返さないが、値は探索した値に決まっている。普通は見つかった行などを後の処理に使うのではと思うが、値では何に使うのかな。 後の重複発見探求はFindNextで追求する必要が有るが、 OrderResultValue = OrderNoResult.Value はなぜ行っているのか。

satoc
質問者

お礼

@書き直しました。 ・やりたいこと ある行に、注文番号が1から連なっています。 この注文番号で構成されるレコードは、重複もあります。 発注「1」 注文変更「1」 決済「1」 のように、多レコードで構成されています。 今回やりたいのは、この発注部分と決済部分の注文番号の取得です。 乱暴な記述をしてしまい申し訳ありません。

satoc
質問者

補足

現在、VBAで、 Find関数で行う処理を記述しています。 以下、記述------------------------ Dim LastRow As String Dim OrderNew As String '最終行を取得 LastRow = Range("B38").End(xlDown).Row oldad = 38 '最終行になるまでループ For cnt = 38 To LastRow '初期値セット(値が詰められている最初の行)。一週目は'1' OrderNo = Range("D" & oldad).Value 'ヘッダーをセット。 Range("K" & cnt).Value = Range("B" & oldad).Value Range("M" & cnt).Value = Range("C" & oldad).Value Range("N" & cnt).Value = Range("D" & oldad).Value Range("O" & cnt).Value = Range("E" & oldad).Value Range("P" & cnt).Value = Range("F" & oldad).Value Range("P" & cnt).Value = Range("G" & oldad).Value Range("Q" & cnt).Value = Range("H" & oldad).Value 'D列の注文番号を検索。Rangeオブジェクトを格納。 Set OrderNoResult = Range("D" & 38 & ":D" & LastRow).Find   (OrderNo, MatchByte:=False, MatchCase:=False,          LookIn:=xlValues, Lookat:=xlWhole, SearchOrder:=xlByRows) 'Rangeオブジェクトから値を格納。 OrderResultValue = OrderNoResult.Value 'ループ。比較。検索される値が見つからなくなったらその行番号を取得し、IF文によりループエンド。その際、次の検索開始位置をoldadで確保。 Do While OrderNoResult.Value = OrderResultValue       oldad = OrderNoResult.Row Set OrderNoResult = Range("D" & 38 & ":D" &LastRow).FindNext(OrderNoResult) If OrderNoResult Is Nothing Then Exit Do End If Loop Range("L" & cnt).Value = Range("B" & oldad).Value Range("R" & cnt).Value = Range("I" & oldad).Value '決済行の次行が、新たな発注番号のため、oldad+1で次行取得。 oldad = oldad + 1 Next cnt 終わり---------------------------- ご教授お願いいたします。

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

関連するQ&A

  • Find関数内にFind関数をかける場合

    エラー91が発生し、手詰まりです。 どなたかご教授お願いいたします。 Find関数でDo~lppoを行い、初期の検索結果アドレスでLoopを抜けようと思ったのですが。。 エラーしてしまいました。 Find関数内にFind関数を用いることが出来ない と目にしたのですが。 下記のようなVBAの場合 どのように対処したらいいでしょうか? また、VBA初心者のため VBA文が見づらかったり、おかしなところがあると思います。 その部分についても教えて頂けたらと思います。 Sub SAMPLE() Dim TargetDE As String '文字列型 Dim TargetNo As String '文字列型 Dim PODate As String '文字列型 Dim FoundCell As Range ' Dim FoundDate As Range Dim FoundCellNo As Long '長整数型 Dim FoundDateNo As String Dim SearchArea As Object 'オブジェクト型 Dim tar_obj(1) As Object 'オブジェクト型 Dim Addr As String '文字列型 Dim Lastrom As Long ' Dim POLEFT As Range '検索文字列入力(DE) TargetDE = Application.InputBox("Fill in a DE:??", "DE:??", Type:=2) If TargetDE = "False" Then Exit Sub '検索対象範囲 Set SearchArea = Workbooks("Sample sample.xlsx").Sheets("Sample") Set tar_obj(1) = Workbooks("INPUT FORMAT.csv").Sheets("INPUT FORMAT") '表示先をクリア tar_obj(1).Cells(1, 1).CurrentRegion.ClearContents '検索実行 Set FoundCell = SearchArea.Range("C:C").Find(What:=TargetDE, LookIn:=xlValues, _ LookAt:=xlPart, MatchCase:=False, MatchByte:=False) '検索文字列(DE)を含むセルがない場合は終了 If FoundCell Is Nothing Then Exit Sub '検索文字列入力(DE Number) TargetNo = Application.InputBox("Fill in DE nomber", "Nomber", Type:=2) If TargetNo = "False" Then Exit Sub '最初の検索結果の行数を格納 Addr = FoundCell.Address '検索文字列入力(PO Date) PODate = Application.InputBox("Fill in Sample Date", "Date", Type:=2) If PODate = "False" Then Exit Sub Do '検索Cell右横の値がTargetNoと同じ場合 If FoundCell.Offset(0, 1).Value = TargetNo Then '行番号を代入 FoundCellNo = FoundCell.Row '検索の下限値を変数に代入 F_LAST = FoundCellNo + 50 '検索実行 Set FoundDate = SearchArea.Range(SearchArea.Cells(FoundCellNo, 1), SearchArea.Cells(F_LAST, 1)).Find(What:=PODate, LookIn:=xlValues, _ LookAt:=xlPart, MatchCase:=False, MatchByte:=False) '検索文字列を含むセルがない場合は終了 If FoundDate Is Nothing Then 'MsgBox "Find is mistake" '検索文字列を含むセルがある場合 Else '変数に行番号代入 FoundDateNo = FoundDate.Row If FoundDate.Offset(1, 1).Value = "" Then MsgBox "The position of the cell is not correct. Please coordinate macro. " Else POLEFT = FoundDate.Offset(1, 1) For i = 2 To 13 If FoundDate.Offset(1, i) <> 0 Then If FoundDate.Offset(1, i) <> "." Then If IsNumeric(FoundDate.Offset(1, i).Value) = True Then '表示先(INPUT FORMAT)の行数をカウントアップ cnt = cnt + 1 PORIGHT = FoundDate.Offset(1, i).Value tar_obj(1).Range("E" & cnt) = POLEFT & PORIGHT End If End If End If Next i End If End If ElseIf FoundCell.Offset(0, 1) <> TargetNo Then ' MsgBox "Find is mistake" End If '次の検索を実行 Set FoundCell = SearchArea.Range("C:C").FindNext(After:=FoundCell) Loop While Not FoundCell Is Nothing And FoundCell.Address <> Addr ' If FoundCell.Offset(0, 1) <> TargetNo Then ' MsgBox "Not Find Number" ' End If End Sub

  • ExcelVBAのFind関数について質問です。

    Find関数を使用して検索を行う際に、検索対象のシートに"ヶ月"、"ヵ月"という文字が記載されていると 処理が遅くなってしまします。 解決方法をご存知の方いらっしゃいますでしょうか? 以下、読みにくいプログラムかもしれませんが、ご教授願います。 Sub ボタン1_Click() Dim value As String Dim pass As String Dim template As Workbook Dim object As Object '検索対象文字 value = "A" 'テンプレートのパス pass = "C:\template.xls" 'テンプレートを開く Set template = Workbooks.Open(pass) 'テンプレートをコピー ActiveWorkbook.Sheets.Copy 'テンプレートを閉じる template.Close saveChanges:=False With ActiveWorkbook.ActiveSheet.Range(Cells(1, 1), Cells(10000, 256)) 'テンプレートにAという文字が存在するかのチェック Set object = .Find(What:=value, LookAt:=xlPart, SearchOrder:=xlByRows) Do '存在しない場合は処理を終了 If object Is Nothing Then End '存在する場合はA→Bに置き換える Else object = Replace(object, value, "B") End If '引き続きSheet2にAという文字が存在するかのチェック Set object = .Find(What:=value, LookAt:=xlPart, SearchOrder:=xlByRows) Loop While Not object Is Nothing End With End Sub

  • 他のブックでマクロを実行するには?

    以下のマクロを実行すると同一ブック内の他のシートに入力 されますが、これを他のブックのシートに入力されるように するには、具体的にどのようにすればいいのでしょうか? ご教授ください。 ---------------------------------------------------------------- Sub 入力() Dim LastRow As Long With Worksheets("sheet2") LastRow = Worksheets("sheet2").Range("B" & Rows.Count).End(xlUp).Row + 1 .Range("B" & LastRow).Value = Worksheets("sheet1").Range("B1").Value .Range("C" & LastRow).Value = Worksheets("sheet1").Range("B3").Value .Range("D" & LastRow).Value = Worksheets("sheet1").Range("B5").Value .Range("E" & LastRow).Value = Worksheets("sheet1").Range("B7").Value .Range("F" & LastRow).Value = Worksheets("sheet1").Range("B9").Value .Range("G" & LastRow).Value = Worksheets("sheet1").Range("B11").Value End With End Sub

  • 実行時エラー'1004': アプリケーション定義またはオブジェクト定義

    実行時エラー'1004': アプリケーション定義またはオブジェクト定義について Dim code As String Dim lastrow As Integer Dim i As Integer Sub calc() Dim code As String Dim day_s As Integer, month_s As Integer, year_s As Integer Dim day_e As Integer, month_e As Integer, year_e As Integer Dim row_length As Integer code = "998407.o" day_e = 31 month_e = 12 year_e = 2005 day_s = 1 month_ = 1 year_s = 2005 Range("B4:H65536").ClearContents For i = 0 To 365 * 0.65 Step 50 URL = "URL;http://table.yahoo.co.jp/t?s=" & code & "&a=" & month_s & "&b=" & day_s & "&c=" & year_s & "&d=" & month_e & "&e=" & day_e & "&f=" & year_e & "&g=d&q=t&y=" & i & "&z=" & code & "&x=.csv" If i = 0 Then lastrow = 4 Call GETデータ If Range("B4") = "" Then Exit Sub End If Else lastrow = Range("B4").End(xlDown).Row + 1 Call GETデータ Range("B" & lastrow, "H" & lastrow).Delete row_length = Range("B4").End(xlDown).Row If row_length - lastrow < 49 Then Exit For End If End If Next Range("B5:H65536").Sort key1:=Columns("B") lastrow = Range("B4").End(xlDown).Row Range("B5", "B" & lastrow).NumberFormatLocal = "yyyy/mm/dd" Range("A1").Select End Sub もうひとつ Sub GETデータ() With ActiveSheet.QueryTables.Add(Connection:=URL, Destination:=Cells(lastrow, 2)) ↑ここにデバックで黄色になります。 .Name = "t?s=998407.o&g=d" .FieldNames = True .RowNumbers = False .FillAdjacentFormulas = False .PreserveFormatting = True .RefreshOnFileOpen = False .BackgroundQuery = True .RefreshStyle = xlInsertDeleteCells .SavePassword = False .SaveData = True .AdjustColumnWidth = True .RefreshPeriod = 0 .WebSelectionType = xlSpecifiedTables .WebFormatting = xlWebFormattingNone .WebTables = "10" .WebPreFormattedTextToColumns = True .WebConsecutiveDelimitersAsOne = True .WebSingleBlockTextImport = False .WebDisableDateRecognition = False .WebDisableRedirections = False .Refresh BackgroundQuery:=False End With End Subになります。Excel2007です。

  • Excel VBAマクロで実行時エラー'91'が出てしまいます。

    実行時エラー'91' オブジェクト変数またはWithブロック変数が設定されていません というエラーが出ます 同じような質問をいくつか見つけました。 FindでTRUEが見つからなくなったときの処理が問題?だと思うんですが、それを解決するために、どうしていいか分かりません。 よろしくお願いします。 AL列にTRUEとある行を削除するマクロです。 処理が正常に終わり、最後にエラーが出ます。 Sub 行削除() lastrow = Range("AL1").End(xlDown).Row i = 1 Dim trow As String Do While i < lastrow trow = Range("AL:AL").Find(What:="TRUE").Row Rows(trow).Delete i = i + 1 Loop End Sub

  • Match関数がうまく機能していない??

    すみません。また教えて下さい。 過去ログを見てシート1にあったデータをシート4にあるデータと照らし合わせてすでにあれば書き換え、なければ追加というようにできるようにしたく過去ログを参考にしてやったのですが、どうしてもエラーが出てしまいます。 Private Sub aa() Dim intlastrow1 As Integer Dim strb As String Dim longlastrow1 As Long intlastrow1 = Sheets(1).Range("A7").End(xlDown).Row longlastrow1 = Sheets(4).Range("A1").End(xlDown).Row Dim c As Object Dim rtn As Variant Dim d As Integer With Sheets(4) .Select For Each c In .Range("A1", "A" & longlastrow1) rtn = Application.Match(c.Value, Sheets(1).Range("A7:A" & intlastrow1), 0) d = c.Row strb = Cells(d, "A").Value If IsError(rtn) Then With Sheets(4).Cells(longlastrow1 + 1, "A") .Value = strb With .Font .Name = "MS Pゴシック" .Bold = False .Size = 8 End With End With Sheets(4).Cells(longlastrow1 + 1, "B").Value = Sheets(1).Range("A2").Value Sheets(4).Cells(longlastrow1 + 1, "F").Value = ShowFormula(Sheet1.Range(Cells(d, "J"), Cells(d, "N"))) longlastrow1 = longlastrow1 + 1 End If If Not IsError(rtn) Then Exit Sub End If Next c End With End Sub 以上のように組んだのですがうまくいきません。 具体的に言うとシート1のA7よりしたに名前が並んでいる(山田、鈴木・・・)とお考え下さい(シート4のA2以下にも同様に名前が並んでいる)。字数の関係で判定後の処理が不十分になっています。

  • 教えてマクロの記述?

    シート1に記述した内容をシート2に一覧形式で入力するマクロを以下の通り作成しました。 シート1に記述した内容を、別のブックのシートに一覧形式で入力していくマクロに変更するには どのようにマクロの記述をすれば宜しいのでしょうか?マクロの初心者にも分るようにご教授 いただければ助かります。よろしくお願いします。 Sub 入力() Dim LastRow As Long With Worksheets("sheet2") LastRow = Worksheets("sheet2").Range("B" & Rows.Count).End(xlUp).Row + 1 .Range("B" & LastRow).Value = Worksheets("sheet1").Range("B1").Value .Range("C" & LastRow).Value = Worksheets("sheet1").Range("B3").Value .Range("D" & LastRow).Value = Worksheets("sheet1").Range("B5").Value .Range("E" & LastRow).Value = Worksheets("sheet1").Range("B7").Value .Range("F" & LastRow).Value = Worksheets("sheet1").Range("B9").Value .Range("G" & LastRow).Value = Worksheets("sheet1").Range("B11").Value End With End Sub

  • マクロのソートについて

    A列:E列のセルデータがあって、空欄を省いて、コピペでるようにしたのでが、新たに、D列を最初にソート、後からB列・C列を連動させてソートしたいのですが、うまく処理できません。ご教授願えませんか。Sheets("ZZZZZZZ")のデータは1行おきのようなデータです。コピペまではできていますが、その後のソートについてお願いします。 Sub Macro1() Application.ScreenUpdating = False Dim Rng As Range Dim LastRow As Long '●ここをだけ"B2:B100"指定する For Each Rng In Sheets("ZZZZZZZ").Range("B2:B100") If Rng.Value <> "" Then LastRow = Sheets("QQQQQQQQ").Cells(Rows.Count, "B").End(xlUp).Row Sheets("QQQQQQQQ").Cells(LastRow + 1, "B").Resize(1, 3).Value = Rng.Resize(1, 3).Value End If Next Rng Application.CutCopyMode = False Application.ScreenUpdating = True End Sub

  • VBAの追加

    同じ様な場所からデータを取り出す時、欲しい情報はWebTables="5"でK3に「5」を入力しておきますが、たまに1つか2つくらい場所違いにより欲しい情報はWebTables="4"の時が存在します。 l3(エル3)に「4」を入力しておいて、WebTables =5に欲しくない情報が入っている場合はWebTables =4を使用するという命令を追加したいと思います。 下記右側のようにセルに「メーカー」の文字が入っていればそのままWebTables =5を使い、「メーカー」の文字が入っていなければWebTables =4を実行 と考えております。 また、それ以外の方法でも構いませんのでお願い致します。 Dim i As Long Dim myAddress As String lastrow = ActiveSheet.Range("A3").End(xlDown).Row d = 50 For i = 3 To lastrow myAddress = Range("B" & i).Value Dim bbb As String bbb = Range("K3").Value With ActiveSheet.QueryTables.Add(Connection:= _ "URL;" & myAddress, Destination:=Range("B" & d + 1)) .FieldNames = True .RowNumbers = False .FillAdjacentFormulas = False .PreserveFormatting = True .RefreshOnFileOpen = False .BackgroundQuery = True .RefreshStyle = xlInsertDeleteCells .SavePassword = False .SaveData = True .AdjustColumnWidth = True .RefreshPeriod = 0 .WebSelectionType = xlSpecifiedTables .WebFormatting = xlWebFormattingNone .WebTables = "" & bbb .WebPreFormattedTextToColumns = True .WebConsecutiveDelimitersAsOne = True .WebSingleBlockTextImport = False .WebDisableDateRecognition = False .WebDisableRedirections = False .Refresh BackgroundQuery:=False End With d = Range("B65536").End(xlUp).Row Next i                     WebTables =5の場合                     正しく欲しい情報                     111111111111111111         メーカー1111111111                     111111111111111111     →   11111111111111111                     111111111111111111         11111111111111111 WebTables =4の場合 正しく欲しい情報      欲しくない情報が入っている 111111111111111111     222222222222222222 111111111111111111     222222222222222222 111111111111111111     222222222222222222

  • エクセルのフォームのVBAについて

    VBAがまったくわからないのに参考書を見て高度な事に挑戦しています フォームは作れてフォームをクリックやら入力やらして作ったOKボタンを押すと シート2のA1B1C1‥の列に入力文字だけが羅列されます。 しかし次にやろうとするとA2B2C2‥と下に行かず又A1B1C1‥の列の文字が変更になり続きません。何がいけないのでしょうか? Sub 入力() Dim LastRow As Long With Worksheets("sheet2") LastRow = Worksheets("sheet2").Range("A" & Rows.Count).End(xlUp).Row .Range("A" & LastRow).Value = Worksheets("sheet1").Range("A5").Value .Range("B" & LastRow).Value = Worksheets("sheet1").Range("A7").Value .Range("C" & LastRow).Value = Worksheets("sheet1").Range("A8").Value .Range("D" & LastRow).Value = Worksheets("sheet1").Range("A10").Value End With End Sub と参考書とおりいれたのですが‥。教えて下さい。