- ベストアンサー
【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で同じ値をペーストして、実行して該当したので間違いありません。 また、一度停止し、再度実行すると、その一周は動き、また停止します。これを一回ずつ繰り返す場合は、問題なく処理されます。 オブジェクトの初期化のような処理が必要なのでしょうか? ご教授お願いいたします。
- みんなの回答 (2)
- 専門家の回答
関連する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
- 締切済み
- Visual Basic
- 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
- 締切済み
- Visual Basic
- 他のブックでマクロを実行するには?
以下のマクロを実行すると同一ブック内の他のシートに入力 されますが、これを他のブックのシートに入力されるように するには、具体的にどのようにすればいいのでしょうか? ご教授ください。 ---------------------------------------------------------------- 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
- ベストアンサー
- Visual Basic
- 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 と参考書とおりいれたのですが‥。教えて下さい。
- ベストアンサー
- オフィス系ソフト
- インクジェットix6830の修理期間未定の表示について
- 修理依頼メッセージが出たインクジェットix6830の修理期間がわからない
- キヤノン製品のインクジェットix6830の修理期間についてのお問い合わせ
お礼
解決しました。 私のやりたい処理は、そもそもループで拾える処理だったんですね・・・・。 私があまりに短絡的な発想をしていたみたいで恐縮です。 非常に助かりました。 ありがとうございます。