Results of 1 - 1 of about 228 for エラー値 #N/A (0.017 sec.)
エラー値 (861), #n/a (1385)
- [[20200808155633]]
- #score: 10842
- @digest: d0596b07175f779721bb4b31d3cf6ed4
- @id: 84744
- @mdate: 2020-08-10T18:21:16Z
- @size: 17980
- @type: text/plain
- #keywords: 間発 (145405), rngfind (86151), 注表 (59477), backpath (50119), 時フ (45919), チル (37760), 冷凍 (33005), 日& (28650), faddress (27901), 成¥ (26695), ドブ (24230), 週間 (19661), 表( (16264), 一時 (14811), 間前 (14683), 今週 (14070), yyyymmdd (13704), 発注 (13699), 了日 (12806), 始日 (12459), ル. (12324), 表作 (5760), workbooks (5684), 開始 (5363), 日4 (5265), 日前 (4890), 日3 (4657), 日1 (4460), 終了 (4246), ルド (4162), xlsx (4047), desktop (3940)
- 『VBA全体実行をすると途中で止まってしまう』（ピノ）
いつもお世話になっております。 VBAでステップ実行をすると、処理ができるのに、 全体実行をすると、途中で処理が終わってしまいます。 エラーメッセージは何もでません。 詳細は、下部に全構文を記載させていただきました。 以下1までは処理ができていて、 2の検索ループ以降処理ができなくなってしまいます。 要因とがわかれば教えていただけたら助かります。 1 Range("AB:AB").Copy Range("AB:AB").PasteSpecial Paste:=xlPasteValues 2 '▼3行目〜最終行目に#N/Aがあった場合に該当行の4列目を黄色塗り Dim rngFind As Range Dim fAddress As String Set rngFind = Range("AB3:AB" & i).Find(what:="#N/A", _ LookIn:=xlValues, _ lookat:=xlPart, _ SearchOrder:=xlByColumns, _ SearchDirection:=xlNext, _ MatchCase:=False, _ MatchByte:=False) '見つからなかったら ※見つかったら…If Not rngFind Is Nothing Then If rngFind Is Nothing Then ＜全文＞ Sub テータ加工2_05() Application.DisplayAlerts = False 'On Error Resume Next '<<<<<冷凍・チルドデータをドッキング>>>>> Workbooks("5_完成（05_冷凍）.xlsx").Activate 'コピー_チルドデータを範囲コピー（可変） With Workbooks("5_完成（05_チルド）.xlsx").Worksheets(1) 'A1の1つ下行A2から最後のセルまでを範囲コピー .Range("A2", .Cells.SpecialCells(xlCellTypeLastCell)).Offset(1).Copy End With '貼付け_冷凍データ最終行に貼付け Workbooks("5_完成（05_冷凍）.xlsx").Activate 'A列最終行の1つ下行を選択→貼付け With Cells(Rows.Count, 1).End(xlUp) .Offset(1, 0).Select End With ActiveSheet.Paste Range("A1").Select '▼別名保存 Const MyPath As String = "C:¥Users¥mi¥Desktop¥C026_週間発注表作成¥1_営業確認用" '保存しないで閉じる Workbooks("5_完成（05_チルド）.xlsx").Close False Dim 開始日 As String, 終了日 As String '週間発注日付をファイル名に設定 開始日 = Format(Date + 2, "yyyymmdd") 終了日 = Format(Date + 8, "yyyymmdd") ActiveWorkbook.SaveAs Filename:=MyPath & "¥" & 開始日 & "-" & 終了日 & "週間発注表(05).xlsx", FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False '一時ファイルを開く Workbooks.Open Filename:="C:¥Users¥mi¥Desktop¥C026_週間発注表作成¥4_RPA作業用¥一時ファイル.xlsx" Dim 一時ファイル As Workbook Set 一時ファイル = ActiveWorkbook '<<<<新規商品が無いか確認>>> '▼1週間前のファイルを開く Const BackPath As String = "C:¥Users¥mi¥Desktop¥C026_週間発注表作成¥1_営業確認用¥バックナンバー" Dim 開始日1 As String, 終了日1 As String 開始日1 = Format(Date - 5, "yyyymmdd") 終了日1 = Format(Date + 1, "yyyymmdd") Workbooks.Open Filename:=BackPath & "¥" & 開始日1 & "-" & 終了日1 & "週間発注表(05).xlsx" Columns("A:B").Copy 一時ファイル.Worksheets(1).Paste '保存しないで閉じる Workbooks(開始日1 & "-" & 終了日1 & "週間発注表(05).xlsx").Close False '▼2週間前のファイルを開く Dim 開始日2 As String, 終了日2 As String 開始日2 = Format(Date - 12, "yyyymmdd") 終了日2 = Format(Date - 6, "yyyymmdd") Workbooks.Open Filename:=BackPath & "¥" & 開始日2 & "-" & 終了日2 & "週間発注表(05).xlsx" i = Cells(Rows.Count, 1).End(xlUp).Row Range("A3:B" & i).Copy '最終行の1行下に貼付け 一時ファイル.Activate With Cells(Rows.Count, 1).End(xlUp) .Offset(1, 0).Select End With ActiveSheet.Paste '保存しないで閉じる Workbooks(開始日2 & "-" & 終了日2 & "週間発注表(05).xlsx").Close False '▼3週間前のファイルを開く Dim 開始日3 As String, 終了日3 As String 開始日3 = Format(Date - 19, "yyyymmdd") 終了日3 = Format(Date - 13, "yyyymmdd") Workbooks.Open Filename:=BackPath & "¥" & 開始日3 & "-" & 終了日3 & "週間発注表(05).xlsx" i = Cells(Rows.Count, 1).End(xlUp).Row Range("A3:B" & i).Copy '最終行の1行下に貼付け 一時ファイル.Activate With Cells(Rows.Count, 1).End(xlUp) .Offset(1, 0).Select End With ActiveSheet.Paste '保存しないで閉じる Workbooks(開始日3 & "-" & 終了日3 & "週間発注表(05).xlsx").Close False '▼4週間前のファイルを開く Dim 開始日4 As String, 終了日4 As String 開始日4 = Format(Date - 26, "yyyymmdd") 終了日4 = Format(Date - 20, "yyyymmdd") Workbooks.Open Filename:=BackPath & "¥" & 開始日4 & "-" & 終了日4 & "週間発注表(05).xlsx" i = Cells(Rows.Count, 1).End(xlUp).Row Range("A3:B" & i).Copy '最終行の1行下に貼付け 一時ファイル.Activate With Cells(Rows.Count, 1).End(xlUp) .Offset(1, 0).Select End With ActiveSheet.Paste '保存しないで閉じる Workbooks(開始日4 & "-" & 終了日4 & "週間発注表(05).xlsx").Close False Workbooks(開始日 & "-" & 終了日 & "週間発注表(05).xlsx").Activate i = Cells(Rows.Count, 1).End(xlUp).Row '▼VLOOKUP Range("AB3") = "=VLOOKUP(B3,'[一時ファイル.xlsx]Sheet1'!B:B,1,0)" 'フィルダウン Range("AB3:AB" & i).FillDown '値貼り付け Range("AB:AB").Copy Range("AB:AB").PasteSpecial Paste:=xlPasteValues '▼3行目〜最終行目に#N/Aがあった場合に該当行の4列目を黄色塗り Dim rngFind As Range Dim fAddress As String Set rngFind = Range("AB3:AB" & i).Find(what:="#N/A", _ LookIn:=xlValues, _ lookat:=xlPart, _ SearchOrder:=xlByColumns, _ SearchDirection:=xlNext, _ MatchCase:=False, _ MatchByte:=False) '見つからなかったら ※見つかったら…If Not rngFind Is Nothing Then If rngFind Is Nothing Then Exit Sub Else '見つかったら If Not rngFind Is Nothing Then rngFind.Offset(, -24).Interior.ColorIndex = 6 End If fAddress = rngFind.Address Do rngFind.Offset(, -24).Interior.ColorIndex = 6 Set rngFind = Range("AB3:AB" & i).FindNext(rngFind) If rngFind Is Nothing Then Exit Do Loop While fAddress <> rngFind.Address End If 'AB列クリア Range("AB3:AB" & i).Clear '不要倉庫列削除 Columns("U:V").Delete '<<<<<最終保存して閉じる>>>>> Workbooks(開始日 & "-" & 終了日 & "週間発注表(05).xlsx").Close True '保存しないで閉じる 一時ファイル.Close False End Sub ＜ 使用 Excel:Excel2016、使用 OS:Windows10 ＞ ---- エラーが無かったから、単純に抜けちゃってるだけではないですか? ＞ '見つからなかったら ※見つかったら…If Not rngFind Is Nothing Then ＞ If rngFind Is Nothing Then ＞ Exit Sub ‾‾‾‾‾‾‾‾‾ （稲葉） 2020/08/08(土) 16:17 ---- 少しコードまとめてみました。 テスト環境が無いのでテストまではしておりませんが、少し眺めてみてください。 テストする場合は、バックアップを取ってから試してみてください。 Sub テータ加工2_05() 'On Error Resume Next '週間発注日付をファイル名に設定 Const MyPath As String = "C:¥Users¥mi¥Desktop¥C026_週間発注表作成¥1_営業確認用" '今週のブックの保存先 Const BackPath As String = "C:¥Users¥mi¥Desktop¥C026_週間発注表作成¥1_営業確認用¥バックナンバー" Dim チルドブック As Workbook Dim 今週のブック As Workbook Dim 一時ファイル As Workbook Dim 開始日 As String, 終了日 As String '週間発注保存用 Dim i As Long Dim rngFind As Range '#N/A検索用 Dim fAddress As String '#N/A検索ループ用 Dim n日前 As Long 'n週間前のループ用 Dim BNファイル名 As String 'バックナンバーのファイル名 Application.DisplayAlerts = False '//冷凍・チルドデータをドッキング// ここから 'コピー_チルドデータを範囲コピー（可変） Set チルドブック = Workbooks("5_完成（05_チルド）.xlsx") With チルドブック.Sheets(1) 'A1の1つ下行A2から最後のセルまでを範囲コピー .Range("A2", .Cells.SpecialCells(xlCellTypeLastCell)).Offset(1).Copy End With 'A列最終行の1つ下行を選択→貼付け '★シート名を指定したほうが良いかと。 With Workbooks("5_完成（05_冷凍）.xlsx") .Sheets("Sheet1").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).PasteSpecial xlAll '‾‾‾‾‾‾‾↑‾‾‾‾‾‾‾‾ '★アクティブワークブック・シートだと曖昧なので、ブックとシートは明記する 開始日 = Format$(Date + 2, "yyyymmdd") 終了日 = Format$(Date + 8, "yyyymmdd") .SaveAs Filename:=MyPath & "¥" & 開始日 & "-" & 終了日 & "週間発注表(05).xlsx", FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False Set 今週のブック = Workbooks(.Name) End With '保存しないで閉じる チルドブック.Close False '//冷凍・チルドデータをドッキング// ここまで '//新規商品が無いか確認// ここから '一時ファイルを開く Set 一時ファイル = Workbooks.Open(Filename:="C:¥Users¥mi¥Desktop¥C026_週間発注表作成¥4_RPA作業用¥一時ファイル.xlsx") For n日前 = 1 To -20 Step -7 BNファイル名 = BackPath & "¥" & Format$(Date - n日前 - 6, "yyyymmdd") & "-" & Format$(Date - n日前, "yyyymmdd") & "週間発注表(05).xlsx" '▼1週間前のファイルを開く With Workbooks.Open(BNファイル名, ReadOnly:=True) With Sheets(1) If n日前 = 1 Then '1週間前なら、AB列をコピー .Columns("A:B").Copy 一時ファイル.Sheets(1) Else '2週間前以前なら、最終行を一時ファイルにコピー .Range("A3:B" & .Cells(Rows.Count, 1).End(xlUp).Row).Copy '最終行の1行下に貼付け With 一時ファイル.Sheets(1) .Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).PasteSpecial xlAll End With End If End With '保存しないで閉じる .Close False End With Next n日前 With 今週のブック With .Sheets(1) 'シートを明記 i = .Cells(Rows.Count, 1).End(xlUp).Row '▼VLOOKUP .Range("AB3:AB" & i).Formula = "=VLOOKUP(B3,'[一時ファイル.xlsx]Sheet1'!B:B,1,0)" '値貼り付け .Range("AB3:AB" & i).Value = .Range("AB3:AB" & i).Value '▼3行目〜最終行目に#N/Aがあった場合に該当行の4列目を黄色塗り Set rngFind = .Range("AB3:AB" & i).Find(what:="#N/A", _ LookIn:=xlValues, _ lookat:=xlPart, _ SearchOrder:=xlByColumns, _ SearchDirection:=xlNext, _ MatchCase:=False, _ MatchByte:=False) If rngFind Is Nothing Then '見つからなかったら何もしない 'Exit Sub Else '見つかったら rngFind.Offset(, -24).Interior.ColorIndex = 6 fAddress = rngFind.Address Do rngFind.Offset(, -24).Interior.ColorIndex = 6 Set rngFind = .Range("AB3:AB" & i).FindNext(rngFind) If rngFind Is Nothing Then Exit Do Loop While fAddress <> rngFind.Address End If 'AB列クリア .Range("AB3:AB" & i).Clear '不要倉庫列削除 .Columns("U:V").Delete End With 一時ファイル.Close False .Close True End With '//新規商品が無いか確認// ここまで Application.DisplayAlerts = True End Sub （稲葉） 2020/08/08(土) 17:19 ---- 訂正 ＞.Columns("A:B").Copy 一時ファイル.Sheets(1) .Columns("A:B").Copy 一時ファイル.Sheets(1).Paste （稲葉） 2020/08/08(土) 17:21 ---- 稲葉さま 有難う御座います!! 見つからなかったら…の後のExit Sub がいらなかったんですね!! 削除したら、うまく行くようになりました! 構文までまとめて頂き、大変有難う御座います…。 自分でも不要な構文書いてる気がする…と思いながら、短縮の方法がわからなかったので、そのままにしていました。 いただいた構文で、勉強させていただきます! 本当に有難うございます! （ピノ） 2020/08/08(土) 17:47 ---- 最後の一文は現状のコードにもいれておいた方がいいです Application.DisplayAlerts = True Falseのままエクセル使っていると、閉じたときの「保存しますか?」 のようなダイヤログも出なくなっちゃいます （稲葉） 2020/08/08(土) 18:26 ---- 稲葉様 そうなんですね!!! それは目から鱗です。。 今のコードにも入れるようにします。 親切な情報、本当にありがとうございます!! また、纏めていただいた構文を確認させてもらっていますが、 コメントの書き方や過去ファイルをForでループさせる方法、とても勉強になりました。 色々とありがとうございます。 （ピノ） 2020/08/08(土) 18:37 ---- 解決しているようなので参考程度に。 ■1 ＞見つからなかったら…の後のExit Sub がいらなかったんですね!! ステップ実行をしているなら、原因自体はご自身で確認できたのではないでしょうか? また、本当に"何もしない"（プロシージャを抜けることもしない）のであれば、そもそも記述しなくてよいでしょう。 Sub 実験1() Stop Dim tmp As Range If tmp Is Nothing Then 'なにもしない Else MsgBox "テキトー" End If End Sub '------------------------------------------- Sub 実験2() Stop Dim tmp As Range If Not tmp Is Nothing Then MsgBox "テキトー" End If End Sub ■2 [[20200806235620]]の時にも思いましたが、本当に「本日」（マクロを実行した日）でよいのですか? 週間発注表なんて書いてあるところから想像するに、1週間単位の処理じゃないんでしょうか。 休日なんかで、締め日?にマクロを実行できない場合に困ったことになりませんか? 私が作るなら処理日を別途入力するなり、マクロを実行した日がどの週に属するのか判定するなどの処理を入れると思います。 ■3 コメントアウトしてますが、冒頭の「On Error Resume Next」は何用ですか? エラーが発生するからよくわからないけど飛ばしてました〜なんてことであれば、やめたほうがいいです。 "一知的に"エラーを無視したい場合は、その部分に記述すべきです。 ■4 (1) VLOOKUPを使った数式を書き込む (2) 値貼り付けをする (3) "#N/A"を検索する (4) 見つかったら塗りつぶしをする (5) 作業用に使ったセルをクリアする ↑の部分は、↓のようにしてもよいとおもいます。 (1) VLOOKUPを使った数式を書き込む (2) エラー値になっているセルがあれば、塗りつぶしをする (3) セルをクリアする よって、こんな感じでもOKじゃないでしょうか（元コードが読みづらかったので稲葉さんが整理されたコードをベースにしています。） With 今週のブック With .Sheets(1) 'シートを明記 i = .Cells(Rows.Count, 1).End(xlUp).Row With .Range("AB3:AB" & i) '▼数式を書き込む .Formula = "=VLOOKUP(B3,'[一時ファイル.xlsx]Sheet1'!B:B,1,0)" '▼一時的にエラーを無視してから（エラー値がなかった時の対策）、エラー値になっているセルの色の塗りつぶし色を設定 On Error Resume Next .SpecialCells(xlCellTypeFormulas, xlErrors).Offset(, -24).Interior.ColorIndex = 6 On Error GoTo 0 '▼クリアするなら値貼付けは要らない .Clear End With End With End With ■5 問題があるわけではないですが、↓についてどの環境でも必ず同じ色にはならないことは理解されておいたほうがよいです。 .Interior.ColorIndex = 6 【参考】 http://officetanaka.net/excel/vba/graph/24.htm ■6 コピーする部分についても、↓のような感じでもよいとおもいます。 （コメントつけましたが、タイプミスと思われる部分があったので直しています。正しければ元に戻してください） Dim チルドブック As Workbook Dim 今週のブック As Workbook Dim コピー範囲 As Range Set チルドブック = Workbooks("5_完成（05_チルド）.xlsx") Set 今週のブック = Workbooks("5_完成（05_冷凍）.xlsx") With チルドブック.Sheets(1) '// Offset(1)はいつものタイプミスでは?「A"1"」だったら分かりますが・・・ Set コピー範囲 = .Range("A2", .Cells.SpecialCells(xlCellTypeLastCell)) End With コピー範囲.Copy 今週のブック.Sheets("Sheet1").Cells(Rows.Count, 1).End(xlUp).Offset(1) 今週のブック.SaveAs _ Filename:=MyPath & "¥" & Format$(Date + 2, "yyyymmdd") & "-" & Format$(Date + 8, "yyyymmdd") & "週間発注表(05).xlsx", _ FileFormat:=xlOpenXMLWorkbook （もこな2 ） 2020/08/11(火) 03:21... - http://www.excel.studio-kazu.jp/wiki/kazuwiki/202008/20200808155633.txt - [detail] - similar
PREV
NEXT
Powered by Hyper Estraier 1.4.13, with 97013 documents and 608132 words.
訪問者：