[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]
『VBA ❶VLOOKUP,❷最終行カウント分の行挿入をしたい』（ピノ）
いつもお世話になっております。
下記構文の★部分について2点質問させてください。
❶VLOOKUP
以下の通り記載していますが、VLOOKが全て＃N/Aになってしまいます。
どこか間違っているところがあれば教えて頂きたいです。
❷最終行カウント分の行挿入をしたい
最終行数を取得し、その分の行を挿入する
という構文構成が思いつきません。
こちらもアドバイス頂けたら助かります。
ちなみに、やりたいこととしては、
前週データと今週データを比較し、
前週データにあって今週データに存在しない商品を
VLOOKで洗い出し、記載したいです。
Sub処理()
Dim LR As Long
Dim i As Long
Dim完成ファイル1 As Workbook
Set 完成ファイル1 = ActiveWorkbook
'1週間前のファイルを開く
Const BackPath As String = "\\ net\作成\最終\完成データ1"
Dim 前週開始日 As String, 前週終了日 As String
前週開始日 = Format(Date - 4, "mmdd")
前週終了日 = Format(Date + 4, "mmdd")
Workbooks.Open Filename:=BackPath & "\" & "B" & 前週開始日 & "-" & 前週終了日 & ".xlsx"
Dim BNファイル名 As Workbook '前週のファイル名
Set BNファイル名 = ActiveWorkbook
完成ファイル1.Activate
'シート追加
Worksheets.Add after:=Worksheets(Worksheets.Count), Count:=1
ActiveSheet.Name = "カット"
BNファイル名.Activate
Worksheets("週間発注表").Select
'前週データの最終行取得
LR = Cells(Rows.Count, "A").End(xlUp).Row
'▼VLOOK処理
完成ファイル1.Activate
Sheets("週間発注表").Select
★ Range("q4") = "=VLOOKUP(a4,[BNファイル]週間発注表!a:b,1,0)"
'フィルダウン
Range("q4:q" & LR).FillDown
'フィルタをかける
Range("q3").AutoFilter 1, "#N/A"
'最終行
LR = Cells(Rows.Count, "q").End(xlUp).Row
★ '最終行カウント分行を挿入
'可視セルのみコピー
Range("q4:q" & LR).SpecialCells(xlCellTypeVisible).Copy
'値貼付け
Range("a1").PasteSpecial Paste:=xlPasteValues
End Sub
＜ 使用 Excel：Excel2010、使用 OS：Windows10 ＞
Dim完成ファイル1 As Workbook
↓
Dim 完成ファイル1 As Workbook
Range("q4") = "=VLOOKUP(a4,[BNファイル]週間発注表!a:b,1,0)"
↓
Range("q4") = "=VLOOKUP(a4,[" & BNファイル名.Name & "]週間発注表!a:b,1,0)"
スマホで見ただけなので、ほかにもありそうですが…
※ちなみに、変数名なので好きにすればよいですが、ファイル と ファイル名 意味が逆じゃないです？
（もこな２ ） 2020/09/11(金) 20:06
■１
VBEのコードをそのままコピペはできないんでしょうか？
コメントを見ると、少なくとも１度は自己検証してみた（実行できた）ような書きぶりですが、そのままでは構文エラーなり、コンパイルエラーになると思われる個所があります。
Sub処理() → Sub 処理() Dim完成ファイル1 As Workbook → Dim 完成ファイル1 As Workbook
■２
以前もコメントしましたが、VBAの世界では、基本的に対象のブックやシート（オブジェクトといいます）を指定すれば、いちいちアクティブにしたり、選択したりする必要はありません。
※忘れちゃった場合は↓を参照 [[20200414113828]] 『ＶＢＡコピペでのエラー』（ピノ）
■３
こちらも以前コメントしましたが、本当に↓でよいのですか？
マクロを実行した日に思いっきり依存しますけど・・・・
前週開始日 = Format(Date - 4, "mmdd") 前週終了日 = Format(Date + 4, "mmdd")
※↓でコメントしています。 [[20200808155633]] 『VBA全体実行をすると途中で止まってしまう』（ピノ）
■４
確認ですが、↓はThisWorkbookとは別物ですか？
Set 完成ファイル1 = ActiveWorkbook
■５
以下の処理について、LRは【前週ファイル】側のA最終行としていますが、本来は【完成ファイル1】のA列最終行であるべきでは？
BNファイル名.Activate
Worksheets("週間発注表").Select
LR = Cells(Rows.Count, "A").End(xlUp).Row
完成ファイル1.Activate
Sheets("週間発注表").Select
Range("q4:q" & LR).FillDown ★ここ
■６
↓の部分について、オートフィルタで抽出したものをコピーする場合は、わざわざ可視セルを指定しなくてもそうなります。
Range("q4:q" & LR).SpecialCells(xlCellTypeVisible).Copy
（もこな２） 2020/09/12(土) 18:02
タイプミス、失礼しました。
以下については、そもそもご教授いただいた書き方を知りませんでした。
BNファイル名は、変数になのですが、
、その場合は[&.name&]と記載するのでしょうか？
もこな２様に頂いたコードに書き換えてみたところ、
アプリケーション定義またはオブジェクト定義のエラーとでてしまいました。。
※ちなみに、BNファイルはOPENになっている状態で、週間発注表シートも存在します。
Range("q4") = "=VLOOKUP(a4,[BNファイル]週間発注表!a:b,1,0)"
↓
Range("q4") = "=VLOOKUP(a4,[" & BNファイル名.Name & "]週間発注表
（ピノ） 2020/09/13(日) 15:46
以下も有難うございます。
■１
VBEのコードをそのままコピペはできないんでしょうか？
コメントを見ると、少なくとも１度は自己検証してみた（実行できた）ような書きぶりですが、そのままでは構文エラーなり、コンパイルエラーになると思われる個所があります。
→実は、VBEコードをそのままコピペすると、本サイトに投稿する際に文字化けしてしまうので、いつもワードに張り付けて投稿していました。
そのためにいつも不要な空欄などが入ってしまっているようです。
皆様はどのようにコードの書き込みをしているのでしょうか。
今更な質問ですみません。
■２
以前もコメントしましたが、VBAの世界では、基本的に対象のブックやシート（オブジェクトといいます）を指定すれば、いちいちアクティブにしたり、選択したりする必要はありません。
→本件、以前ご教授いただいてから、Activateを使用せずTRYしているのですが、
ワークブック.ワークシート＋指定操作にしても、エラーになってしまうことが多く、Activateに頼ってしまっていました。。今後身に着けられるようにしたいと思います。
■３
こちらも以前コメントしましたが、本当に↓でよいのですか？
マクロを実行した日に思いっきり依存しますけど・・・・
前週開始日 = Format(Date - 4, "mmdd") 前週終了日 = Format(Date + 4, "mmdd")
→このマクロを使用するのが週1回決まった日なので、この日を基軸に指定した日付のファイルを開く、というようにしています。テストのときは、テスト用にその日付のファイルを作っています。
■４
確認ですが、↓はThisWorkbookとは別物ですか？
Set 完成ファイル1 = ActiveWorkbook
→はい、別物になります。
■５
以下の処理について、LRは【前週ファイル】側のA最終行としていますが、本来は【完成ファイル1】のA列最終行であるべきでは？
BNファイル名.Activate
Worksheets("週間発注表").Select
LR = Cells(Rows.Count, "A").End(xlUp).Row
→おっしゃる通りでした。
頭がごっちゃになっていました…
有難うございます！！
完成ファイル1.Activate
Sheets("週間発注表").Select
Range("q4:q" & LR).FillDown ★ここ
■６
↓の部分について、オートフィルタで抽出したものをコピーする場合は、わざわざ可視セルを指定しなくてもそうなります。
Range("q4:q" & LR).SpecialCells(xlCellTypeVisible).Copy
→オートフィルターをかけた場合は、可視セルにしなくてもいいんですか…？
普通のPasteでいけるということでしょうか。
（ピノ） 2020/09/13(日) 16:00
■１のレスについて
こちらではそのような現象が起きないのでわかりませんので他の回答者さんの意見も参考にしてみてください。
ただ、私の場合、丸付き数字など環境依存文字は使わないようにしています。
■２のレスについて
＞Activateを使用せずTRYしているのですが、Activateを使用せずTRYしているのですが、ワークブック.ワークシート＋指定操作にしても、エラーになってしまうことが多く〜
モノを見てないのでわかりませんが、結局いつものタイプミスじゃないですかねぇ…
■３のレスについて
えっと。。。伝わりませんかね？テスト時はどうでもよいですが、「週1回決まった日」に実行できなかったらどうするのか気にしています。作業できなかった週はあきらめちゃうんですか？
■４のレスについて
わかりました。
ということは、すくなくとも登場するブックは以下の３つがあるわけですね。
マクロを記述するブック 1週間前のファイル 完成ファイル1
しかも、「完成ファイル1」をアクティブにしてからマクロを実行する決まりになっているという理解でよいのですね？
■６のレスについて
試してみればわかりますよ。
（わざわざコードにせずとも、手作業でやってみても分かると思います。）
■７
「５」に対するレスと、「2020/09/11(金) 20:06」で指摘したことを踏まると、↓のような感じになろうかとおもいます。
With 完成ファイル1.Worksheets("週間発注表")
.Range("Q4:Q" & .Cells(.Rows.Count, "A").End(xlUp).Row).Formula = _
"=VLOOKUP(A4,[" & 前週ファイル.Name & "]週間発注表!A:B,1,0)"
.Range("Q3").AutoFilter 1, "#N/A"
Intersect(.AutoFilter.Range, .AutoFilter.Range.Offset(1), .Range("Q:Q")).Copy
.Range("A1").PasteSpecial Paste:=xlPasteValues
End With
そうなると、"#N/A"という文字列を、同じシートのA1以下に貼り付けることになりますが、やりたいことはそれで正しいのですか？
■８
問題があるということではないですが、「完成ファイル1」に作成した"カット"シートは何用なんですか？
コードを見る限りノータッチですけど・・・
もしかしたら、「７」はカットシートに出力するのが正しかったりしませんか？
（もこな２） 2020/09/13(日) 18:01
いつも有難うございます。
読みづらくて大変失礼しました…
■３のレスについて
→一応、RPA（自動）で定刻にやろうと思っているので、大丈夫だとは思うのですが、、確かに不測の事態で日がずれる可能性もあります。可変の日付を指定出来るいい方法あったら教えていただきたいです。
■４のレスについて
はい、その認識で大丈夫です。
■６のレスについて
有難うございます。試してみて出来そうでした！
■７のレスについて
有難うございます。
頂いたコードで実行しましたが、VLOOKの結果が何も表示されません。エラーにもならず…
"#N/A"という文字列を、同じシートのA1以下に貼り付けることになりますが、やりたいことはそれで正しいのですか？
→ここは、"#N/A"行のA列の値を、"#N/A"行数分行挿入後に、
A1以下に張り付けるという以下のコード追加しました。
説明不足で申し訳ありません。
'1行目から"#N/A"行カウント分の行挿入
Rows("1" & ":" & LR).Insert
'可視セルのみコピー
Range("a" & LR, "d" & LR * 2).SpecialCells(xlCellTypeVisible).Copy
'値貼付け
Range("a1").PasteSpecial Paste:=xlPasteValues
■８ のレスについて
→おっしゃる通りです！！こちらも修正いたしました。
カットシートにこの操作を行う、が正しいです。
ご指摘、すみません。有難うございます。
（ピノ） 2020/09/13(日) 20:38
ちなみに、読んでなさそうですが[[20200808155633]]で↓のように、書きましたよ。
＞＞私が作るなら処理日を別途入力するなり、マクロを実行した日がどの週に属するのか判定するなどの処理を入れると思います。
■10
＞頂いたコードで実行しましたが、VLOOKの結果が何も表示されません。エラーにもならず…
実際のコードを見せてください。
結局タイプミスor適当に真似して記述したから想定外の動作をしているじゃないですかね・・・
なお、ちゃんとステップ実行してデバッグ作業してますか？
また、よくわからない命令はちゃんとネット検索して理解するようにしてますか？
■11
＞こちらも修正いたしました。
＞カットシートにこの操作を行う
ならば、一度みせて（提示して）ください。
"この"とはどの操作のことを指しているかよくわからないですし、毎回ミスが多いので本当に修正されたのか疑問なので、その辺の情報を整理してから先に進んだほうがよいでしょう。
（もこな２） 2020/09/14(月) 00:19
関数名は正しく書くべきだと思いますが、それはさておき、 参照したセルには数式で""が入ってたということはないですか？
すなわち""が参照されたことにより"なにもはいってない"ように 見えただけということはないでしょうか。
（もこな２） 2020/09/14(月) 01:56
(1)前週データの２行目〜A列最終行までを順番に (2)COUNTIF関数で今週データの有無を判定して (3)無い場合は、「カット」シートのA列最終行に書き込む
とすればよいでしょう。
（つまりVLOOKUP関数での処理や、行挿入する必要はないのではと思ってます。）
（もこな２） 2020/09/14(月) 08:24
色々有難うございます。
今回は、VLOOKUP関数がどうしてもわからなかったため、この回答をいただく前に、
別ブックを作成し、そこにVLOOKの数式を予め組んでおき、比較する前週と当週のデータを張り付ける、
という流れにしました。
もこな２様のおっしゃる通り、CountIfsを使えばもっと簡単に処理できそうなので、今後の参考にさせていただきます。
VBA、関数をうまく組み合わせれば、もっと容易にコードが書けるようになりそうですが、
なかなか構成が思いつかず、面倒なことをやってしまっている気がします。
もう少し上達できるよう、頑張ります。
今後ともよろしくお願いいたします。
（ピノ） 2020/09/14(月) 22:30
■番外３（10、11の再掲）
実際のコードを見せてください。
一度みせて（提示して）ください。
（もこな２） 2020/09/15(火) 03:24
せっかくコメントいただいたのに、見落としており申し訳ございませんでした。
今回は、VLOOKUP関数がどうしてもわからなかったため、
別ブック（VLOOKUP_IB.xlsx）を作成し、そこにVLOOKの数式を予め組んでおき、
比較する前週と当週のデータを張り付ける、 という流れで以下コードを記載しました。
ただ、VLOOKUPについても後のレスで、解決しましたので、今後は活用できそうです。
ありがとうございます。
Sub 処理()
' On Error Resume Next
'確認ダイアログボックスを非表示にする。（削除しますか？など） Application.DisplayAlerts = False
Dim LR As Long, LR2 As Long
Dim i As Long
Dim pv As PivotTable
Dim sh As Worksheet
Dim 一時ファイル As Workbook, 完成ファイル1 As Workbook
Dim fpath As Variant
Const MyPath As String = "C:\Users\mi\Desktop\fs01\fs01_045\保管ライブラリー\C019_週間発注表作成\最終\完成データ1"
Dim 開始日 As String, 終了日 As String
Dim 前週開始日 As String, 前週終了日 As String
'-----処理1-------
'ピボットファイルを開く
Workbooks.OpenText Filename:= _
"C:\Users\mi\Desktop\fs01\fs01_045\保管ライブラリー\C019_週間発注表作成\作業用ファイル\ピボット更新フォーム.xlsx"
'▼保存 'ファイル名：IB 週間発注開始日mmdd-終了mmdd
'週間発注日付をファイル名に設定
開始日 = Format(Date + 3, "mmdd")
終了日 = Format(Date + 11, "mmdd")
ActiveWorkbook.SaveAs Filename:=MyPath & "\" & "IB" & 開始日 & "-" & 終了日 & ".xlsx", FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
Set 完成ファイル1 = ActiveWorkbook
'---ここまで--処理1---------
'------処理2------
'VLOOK用ファイルOPEN
Workbooks.Open Filename:="C:\Users\mi\Desktop\fs01\fs01_045\保管ライブラリー\C019_週間発注表作成\作業用ファイル\VLOOKUP_IB.xlsx"
'1週間前のファイルを開く
前週開始日 = Format(Date - 4, "mmdd")
前週終了日 = Format(Date + 4, "mmdd")
Workbooks.Open Filename:=MyPath & "\" & "IB" & 前週開始日 & "-" & 前週終了日 & ".xlsx"
Dim BNファイル名 As Workbook '前週のファイル名
Set BNファイル名 = ActiveWorkbook
'A列をコピーしてVLOOK用ファイルA列に貼付け
Columns("A:A").Copy Workbooks("VLOOKUP_IB.xlsx").Worksheets(1).Range("e1")
完成ファイル1.Activate
'A列をコピーしてVLOOK用ファイルA列に貼付け
Columns("a:d").Copy Workbooks("VLOOKUP_IB.xlsx").Worksheets(1).Range("a1")
'シートコピーしてシート名をカットとする
Worksheets("週間発注表").Copy after:=Worksheets("週間発注表")
ActiveSheet.Name = "カット"
Workbooks("VLOOKUP_IB.xlsx").Activate
'hitしなかった商品でフィルタをかける
Range("a3").AutoFilter 6, Criteria1:=Array("0"), Operator:=xlFilterValues
LR = Range(Range("A2"), Cells(Rows.Count, 1).End(xlUp)) _
.SpecialCells(xlCellTypeVisible).Count
'該当商品数分の行挿入
完成ファイル1.Worksheets("カット").Rows("1" & ":" & LR).Insert
'可視セルのみコピぺ
Range("a3:d" & LR).SpecialCells(xlCellTypeVisible).Copy
' Workbooks("VLOOKUP_IB.xlsx").Worksheets(1).Range("a3").CurrentRegion.Copy
完成ファイル1.Worksheets("カット").Range("a2").PasteSpecial
'▼上書き保存して閉じる
完成ファイル1.Close True
'保存しないで閉じる
BNファイル名.Close False
Workbooks("VLOOKUP_IB.xlsx").Close False
'--ここまで------処理2------
End Sub
（ピノ） 2020/09/19(土) 18:11
(1)
Workbooks.OpenText Filename:= _ C:\Users\mi\Desktop\fs01\fs01_045\保管ライブラリー\C019_週間発注表作成\作業用ファイル\ピボット更新フォーム.xlsx"
↑は、何故xlsxファイルを「OpenText」で開きたいのですか？
(2)
「一時ファイル」は使ってませんが何用ですか？
(3)
Columns("A:A").Copy Workbooks("VLOOKUP_IB.xlsx").Worksheets(1).Range("e1")
Columns("a:d").Copy Workbooks("VLOOKUP_IB.xlsx").Worksheets(1).Range("a1")
Range("a3").AutoFilter 6, Criteria1:=Array("0"), Operator:=xlFilterValues
LR = Range(Range("A2"), Cells(Rows.Count, 1).End(xlUp)).SpecialCells(xlCellTypeVisible).Count
Range("a3:d" & LR).SpecialCells(xlCellTypeVisible).Copy
↑例によって、アクティブシートを対象にした処理になっていますのでシートを明示するように修正したほうがよいとおもいます。
(4)
Range("a3").AutoFilter 6, Criteria1:=Array("0"), Operator:=xlFilterValues
↑なんで「Array("0")」なんですか？配列にする必要があるんですか？
(5)
LR = Range(Range("A2"), Cells(Rows.Count, 1).End(xlUp)).SpecialCells(xlCellTypeVisible).Count
Range("a3:d" & LR).SpecialCells(xlCellTypeVisible).Copy
↑は正しい範囲が取得できているのですか？
(6)
完成ファイル1.Worksheets("カット").Rows("1" & ":" & LR).Insert
完成ファイル1.Worksheets("カット").Range("a2").PasteSpecial
【１】行目以降に挿入しているのに、【２】行目に貼り付けでよいのですか？
■14
同じ環境が用意できないのでコンパイルエラーにならないことしか確認してませんが、すでに指摘したことや■13などを踏まえるとこうなのでは？
Sub テキトー()
Const ぱす As String = "C:\Users\mi\Desktop\fs01\fs01_045\保管ライブラリー\C019_週間発注表作成"
Dim 基準日 As Date
Dim 完成ファイル1 As Workbook, VLOOK用 As Workbook, BNファイル名 As Workbook
Dim LR As Long
基準日 = Date - (Weekday(Date) - 4)'★マクロを実行した日が属する週の水曜日（4）を基準にする
'-----処理1-------
Set 完成ファイル1 = Workbooks.Open(ぱす & "\作業用ファイル\ピボット更新フォーム.xlsx")
完成ファイル1.SaveAs _
Filename:=ぱす & "\最終\完成データ1\IB" & Format(基準日, "mmdd") & "-" & Format(基準日 + 6, "mmdd") & ".xlsx", _
FileFormat:=xlOpenXMLWorkbook
'---ここまで--処理1---------
'------処理2------
'VLOOK用ファイルOPEN
Set VLOOK用 = Workbooks.Open(ぱす & "\作業用ファイル\VLOOKUP_IB.xlsx")
'1週間前のファイルを開く
Set BNファイル名 = Workbooks.Open(ぱす & "\最終\完成データ1\IB" & Format(基準日 - 7, "mmdd") & "-" & Format(基準日 - 1, "mmdd") & ".xlsx")
'【シートは適当】
BNファイル名.Worksheets(1).Columns("A:A").Copy VLOOK用.Worksheets(1).Range("E1")
With 完成ファイル1
'A列をコピーしてVLOOK用ファイルA列に貼付け【シートは適当】
.Worksheets(1).Columns("A:D").Copy VLOOK用.Worksheets(1).Range("A1")
.Worksheets("週間発注表").Copy after:=Worksheets("週間発注表")
.Worksheets("週間発注表").Next.Name = "カット"
End With
With VLOOK用.Worksheets(1) '【シートは適当】
.Range("A3").AutoFilter 6, Criteria1:="0", Operator:=xlFilterValues
LR = .AutoFilter.Range.Columns(1).SpecialCells(xlCellTypeVisible).Count - 1
If LR > 1 Then
完成ファイル1.Worksheets("カット").Rows("1:" & LR).Insert
Intersect(.AutoFilter.Range.Offset(1), .AutoFilter.Range.Offset(1), .Range("A:D")).Copy 完成ファイル1.Worksheets("カット").Range("A2")
End If
完成ファイル1.Close True
BNファイル名.Close False
VLOOK用.Close False
End With
'--ここまで------処理2------
End Sub
（もこな２） 2020/09/20(日) 11:57
データがこんな感じになってませんかね？、
q
3 項目名
4 #N/A ←ここ以外、これと同じ物が無い
5 い
6 あ
7 い
8 う
9 え
'フィルタをかける
Range("q3").AutoFilter 1, "#N/A"
'最終行
LR = Cells(Rows.Count, "q").End(xlUp).Row
★ '最終行カウント分行を挿入
'可視セルのみコピー
Range("q4:q" & LR).SpecialCells(xlCellTypeVisible).Copy
↓
Range("q4:q" & LR).SpecialCells(xlCellTypeVisible).select
Selectで試して結果を見る
なんか項目飛ばして、Q4つまり4行目から表示されたセルと言うのがネックのような気がする。 Q3からなら問題は無いみたいでした。（今さっき解った） http://www.vbalab.sakura.ne.jp/vbaqa/c-board.cgi?cmd=one;no=87;id=FAQ （Jaka） 2020/09/20(日) 13:57
【抽出前】
___A.....＿_Q_____ 1 2 3 番号 項目１ 4 1001 #N/A 5 1002 1002 6 1003 1003 7 1004 1004 8 1005 #N/A 9 1006 #N/A 10 1007 1007 11 1008 1008
【抽出後】
___A.....＿_Q_____ 1 2 3 番号 項目１ 4 1001 #N/A 8 1005 #N/A 9 1006 #N/A
処理結果としては「A4、A8〜A9」セルをコピー（して出力先に貼付）できれば正解なんだろうなぁと解釈しました。
この場合に、Endプロパティを使って最終行を求める方法であれば
Sub 実験02()
Dim dstSH As Worksheet
Dim LR As Long
With ActiveSheet
Set dstSH = Worksheets.Add(after:=Worksheets(.Name))
.Range("Q3").AutoFilter Field:=1, Criteria1:="#N/A" '★1
LR = .Cells(.Rows.Count, "Q").End(xlUp).Row '★2
.Range("A4:A" & LR).Copy dstSH.Range("A1") '★3
End With
End Sub
★1 エラー値（#N/A）を抽出する ★2 表示されている行のうちＱ列最終行の行番号を取得する （例でいえば9） ★3 A3〜A9をコピー（この時、オートフィルタで非表示になっているセルは対象外になる）して、貼付先に貼付する
となるので、【項目行を除きたいのであれば】コピー対象の列、貼付先シートの指定がおかしかったのを除けば最初の考え方（4行目〜表示されている最終行をコピー）に問題はなかったと思います。
ついでなので、■13-(5)を補足します。
変更（新たに作り直した？）ほうだと
Sub 実験03()
Dim dstSH As Worksheet
Dim LR As Long
With ActiveSheet
Set dstSH = Worksheets.Add(after:=Worksheets(.Name))
.Range("A3").AutoFilter 6, Criteria1:=0 '◆1
LR = Range("A2", Cells(Rows.Count, "A").End(xlUp)).SpecialCells(xlCellTypeVisible).Count '◆2
.Range("A3:D" & LR).SpecialCells(xlCellTypeVisible).Copy dstSH.Range("A1") '◆3
End With
End Sub
◆1 0を抽出する（想像するにCOUNTIFの結果ですかね） ◆2 なぜか、A【２】〜A列の表示されている最終行までの、セル数を数えているから5が取得される ◆3 A3〜D5をコピー（この時、オートフィルタで非表示になっているセルは対象外になる）して、貼付先に貼付する
となり、6行目以降を対象にしないのですから、当然8、9行目はコピーされず、これが正しい処理であるのか非常に疑問だということです。
（もこな２） 2020/09/20(日) 16:29
あれ！意味が通じてないのかな？ リンク先見た？
（Jaka） 2020/09/20(日) 16:33
まぁ、このトピックに限って言えば、■6の反応を見る限り、最初のコードでSpecialCellsを使ったのは可視セルを指定せずとも非表示行が無視されるのを知らなかったから使っただけみたいですし、新たに作成したほうのコードではA〜D列になっており単一セルになりようがないためそこが問題になることは無いように思います。
（もこな２） 2020/09/20(日) 17:43
Sub さんぷる()
Dim 今週データ As Worksheet, 先週データ As Worksheet, dstSH As Worksheet
Dim bufRNG As Range
Dim i As Long
'▼比較対象の２つのシート、出力用のシートをそれぞれ変数にセット
Set 今週データ = ActiveWorkbook.Worksheets(1)
Set dstSH = Worksheets.Add(after:=今週データ)
dstSH.Name = "カット"
Set 先週データ = Workbooks.Open("\\ net\作成\最終\完成データ1\B" & Format(Date - 4, "mmdd") & "-" & Format(Date + 4, "mmdd") & ".xlsx").Worksheets(1)
'▼先週データを巡回して、今週データになければ「bufRNG」にその【セル】を覚える
With 先週データ
For i = 1 To .Cells(.Rows.Count, "A").End(xlUp).Row
If WorksheetFunction.CountIf(今週データ.Range("A:A"), .Cells(i, "A").Value) = 0 Then
If bufRNG Is Nothing Then
Set bufRNG = .Cells(i, "A")
Else
Set bufRNG = Union(bufRNG, .Cells(i, "A"))
End If
End If
Next i
End With
'▼「bufRNG」に覚えたセルがあれば、カットシートに貼り付け
If Not bufRNG Is Nothing Then bufRNG.Copy dstSH.Range("A1")
End Sub
※ 修正されたコードを拝見して対象シートなどを確認してから提示するつもりで考えていましたが、
修正コードは提示されないようなので提示だけしておきます。
もし採用するなら、シートや列などは自力で調整してください。
ちなみに、新規追加したシートに出力するなら【行挿入】いらないとおもうので、なんでそこで悩んでいるのかも疑問でした。
（もこな２） 2020/09/21(月) 10:08
色々と突っ込みどころ満載のコードで失礼しました。
CountIfパターンでのご提示まですみません。
最初にご提示いただいた方法でも、Countifでもやりたいことができました。
既に作成されている週間発注表のシートえおコピーして、シート名を「カット」とし、
カット品を表示させたいため、カット商品分の行挿入処理をしていますが、ここもご提示いただいたCountifでない方の処理で解決いたしました。
Countifの方は、今後の別の処理でとても参考になりました。
Countifの方が、スマートに記載できるのですね。
とても勉強になりました、ありがとうございます。
Jaka様
有難うございます。
SpecialCellの対象範囲が単一セルだとうまくいかないこと、初めて知りました。。
今回は必ず複数セルなので大丈夫かと思いますが、今後使用するときに留意したいと思います。
（ピノ） 2020/09/21(月) 17:32
>SpecialCellの対象範囲が単一セルだとうまくいかないこと、初めて知りました。。
？？？ えー、何でリンク先読んでそうなったのでしょうか？ オートフィルタをかけた後に、表示された最後の行を取得する方法として、 End(xlUp) で取得すると、検索する値が項目名の1つ下にしかない場合に とんでもない事になると言う事の注意です。
（Jaka） 2020/09/21(月) 19:57
>SpecialCellの対象範囲が単一セルだとうまくいかない
私もそう理解しています。
単一セルだけだと、エクセルの気を利かせ機能で「全セルだな」と勝手解釈されちゃう。
（半平太） 2020/09/21(月) 20:54
行 _A_ 1 E 2 C 3 B 4 C
似たような現象で、A列の並べ替えをするとき、 A列全体を選択して、昇順に並べ替える場合と、 (例えば）単にA3セルだけを選択してならべ変える場合では、結果は変わらない。
しかし、A2:A3だけ選択すると、A1とA4には無影響である。 これは当然かも知れないが、同じ理屈ならA3セルだけ選択なら、 並べ替えは起きないハズである（と思う。）
（半平太） 2020/09/21(月) 21:15
(3)はただの意見なので返事のしようがないかもしれませんが。
＞最初にご提示いただいた方法でも、
ちょっとよくわかりません【最初にご提示いただいた方法】とは何を指してますか？
＞Countifでもやりたいことができました。
本当でしょうか？
どうも適当にコメントつけているだけのように感じちゃいます。どうやって試してみたのですか？
＞SpecialCellの対象範囲が単一セルだとうまくいかない
これは私の発言につられちゃったんだと思うんですが、そこじゃないとするとJakaさんが何を気にされているかよくわからないです。
オートフィルタで抽出されているときに、【表示されている行】の最終行のセルを求めるのであれば、Endプロパティを使うことに問題はないような気がするんですが・・・・
（だからこそ、実験02は正しく処理されるのだと思います。）
（もこな２） 2020/09/22(火) 01:03
類似例も交えて、ありがとうございます。
SpecialCellの対象が単一セルの場合は、うまくいかないということは、Jaka様のアドバイスとは別に覚えておくようにいたします。
もこな２様
＞そんな一言で済まされても納得できないので、ちゃんと■13でコメントしたことに対して、返事がほしいところです。
失礼しました。
以下、返答させていただきます。
(1) 何故xlsxファイルを「OpenText」で開きたいのですか？
以前使用したコードを使いまわしていたため、このようにしてしまっていました。
.xlsxのOPENであれば、「OpenText」はいらないですが、エラーにもならなかったので、そのまま使用してしまっていました。気を付けるようにいたします。
(2) 「一時ファイル」は使ってませんが何用ですか？
こちらは、他の工程で使用しているファイルなので、提示したコードでは不要でした。失礼しました。
SubからEnd subまでの全コードを記載すると、別の操作も入って長いので、割愛しておりましたが、その際に不要な変数を消し忘れてしまいました。
(4) なんで「Array("0")」なんですか？配列にする必要があるんですか？
現在は、1条件ですが、今後複数に増える可能性があるため、配列にいたしました。
(5) 正しい範囲が取得できているのですか？
1行目で、A列2行目以降フィルターをかけた後の可視セルの最終行を取得し、2行目でA〜それをコピーしています。
現在の操作では、正しくできているように思えました。ただ、以前アドバイスいただいた通り、「SpecialCells(xlCellTypeVisible).Copy」は、SpecialCells(xlCellTypeVisible)の部分はなくてもよいとのことでしたので、今後の可視セルコピーでは、Copyのみにしたいと思います。
(6) 【１】行目以降に挿入しているのに、【２】行目に貼り付けでよいのですか？
1行目には見出しをつけたいので、2行目から貼付けとしていましたが、それでは挿入行が不足するため、
挿入は＋１行するべきでした。ご指摘ありがとうございます。
失礼しました。
Sub テキトー()のほうです。
Sub countif_データ比較して存在しない値を抽出()
'今週・前週ファイルのＡ列コードを比較し、今週ファイルに存在しない値をカットシートに抽出
Const ぱす As String = "C:\Users\mi\Desktop\保管ライブラリー\週間発注表作成"
Dim 基準日 As Date
Dim 今週データ As Worksheet, 先週データ As Worksheet, dstSH As Worksheet
Dim bufRNG As Range
Dim i As Long
基準日 = Date - (Weekday(Date) - 4) '★マクロを実行した日が属する週の水曜日（4）を基準にする
Workbooks.Open (ぱす & "\最終\完成データ1\IB" & Format(基準日, "mmdd") & "-" & Format(基準日 + 6, "mmdd") & ".xlsx")
Set 今週データ = ActiveWorkbook
'▼比較対象の２つのシート、出力用のシートをそれぞれ変数にセット
Set 今週データ = ActiveWorkbook.Worksheets(1)
Set dstSH = Worksheets.Add(after:=今週データ)
dstSH.Name = "カット"
Set 先週データ = Workbooks.Open("C:\Users\mi\Desktop\保管ライブラリー\週間発注表作成\最終\完成データ1\IB" & Format(Date - 4, "mmdd") & "-" & Format(Date + 4, "mmdd") & ".xlsx").Worksheets(1)
'▼先週データを巡回して、今週データになければ「bufRNG」にその【セル】を覚える
With 先週データ
For i = 1 To .Cells(.Rows.Count, "A").End(xlUp).Row
If WorksheetFunction.CountIf(今週データ.Range("A:A"), .Cells(i, "A").Value) = 0 Then
If bufRNG Is Nothing Then
Set bufRNG = .Cells(i, "A")
Else
Set bufRNG = Union(bufRNG, .Cells(i, "A"))
End If
End If
Next i
End With
'▼「bufRNG」に覚えたセルがあれば、カットシートに貼り付け
If Not bufRNG Is Nothing Then bufRNG.Copy dstSH.Range("A1")
End Sub
以上になります。
色々と、お手間撮らせて申し訳ありません。
業務の都合上、VBAを初めて半年弱ですが、
本サイトで、もこな２様はじめ色々な方々に
教えていただことで習得できたことばかります。
本当にありがとうございます。
（ピノ） 2020/09/22(火) 17:58
(1)「項目行が【３】行目のときに、 (2) フィルターがかかっている状態で、A列の【２】行目以降〜最終行までの【可視セル】の数を取得して (3) A〜D列の3〜(2)の数行目までをコピー
となっています。
どのような問題が起きるかについては、2020/09/20(日) 16:29に■13-(5)の補足として説明しているのでそちらをお読みください。
＞以下でコードで試させていただきました。
本当に試しました？
↓の部分で型が合わないというエラーになりませんか？
Dim 今週データ As Worksheet Set 今週データ = ActiveWorkbook
（もこな２） 2020/09/22(火) 22:21
Sub ちょい修正()
Const ぱす As String = "C:\Users\mi\Desktop\保管ライブラリー\週間発注表作成\最終\完成データ1\IB" '★１
Dim 基準日 As Date
Dim 今週データ As Worksheet, 先週データ As Worksheet, 出力データ As Worksheet
Dim i As Long, 出力行 As Long
基準日 = Date - (Weekday(Date) - 4)
'★２
Set 今週データ = Workbooks.Open(ぱす & Format(基準日 + 0, "mmdd") & "-" & Format(基準日 + 6, "mmdd") & ".xlsx").Worksheets(1)
Set 先週データ = Workbooks.Open(ぱす & Format(基準日 - 7, "mmdd") & "-" & Format(基準日 - 1, "mmdd") & ".xlsx").Worksheets(1)
Set 出力データ = Worksheets.Add(after:=今週データ)
出力データ.Name = "カット"
'★３
With 先週データ
For i = 1 To .Cells(.Rows.Count, "A").End(xlUp).Row
If WorksheetFunction.CountIf(今週データ.Range("A:A"), .Cells(i, "A").Value) = 0 Then
.Cells(i, "A").Copy 出力データ.Cells(出力行 + 1, "A")
出力行 = 出力行 + 1
End If
Next i
End With
End Sub
★１
結局、「今週データ」も「先週データ」もフォルダやファイル名の先頭は同じようですから、そのまま定数にしちゃえばよいでしょう。
★２
「先週データ」は「今週データ」の1週間前（7日前）じゃないんですか？
日付として扱うべきといってるのはそういうことなんですが・・・
★３
別のトピックでメモリーについて気にされているようでした。
そこまで気になるなら「「bufRNG」にその【セル】を覚える」のはやめたほうがいいでしょう。
（もこな２） 2020/09/22(火) 23:00
有難う御座います。
＞020/09/19(土) 18:11に提示されたコードはそうなってませんよ。
理解が乏しくすみません。 補足のコメントも改めて拝見しました。 可視セルの最終行分をカウントして、可視セル最終行分コピーしたかったのですが、 非表示セルまで含めたカウント行しかコピーできてない。ということでしょうか。 この場合の正しい取得は、 Jaka様もおっしゃっていたとおり、先に最終行を取得しておく、で良いんですかね。
の部分で型が合わないというエラーになりませんか？ 確かにそうですね！エラーが出なかったような気がするのですが…
現在実行環境にないため、再度で試してみます。
■15 2020/09/22(火) 17:58 のコードを拝見してちょっと手直ししてみました。
有難う御座います。。
メモリ不足など、素人なのに気にしていてすみません。。
こちらも後ほど試させていただきます。
（ピノ） 2020/09/23(水) 17:56
教えていただいたCountifですが
当方で試したコードの中で
Set 今週データ = ActiveWorkbook
は余計でした。
試して出来た際も、このコードを省いて実施したため、今くいったのかと思います。
違うコードをコピペしてしまい、余計な確認をしていただいてしまい、失礼しました。
■15
こちらもうまくいきました！
メモリ不足が気になる場合の対応として、参考にさせていただきます。
（ピノ） 2020/09/23(水) 18:53
■17
＞この場合の正しい取得は、 Jaka様もおっしゃっていたとおり、先に最終行を取得しておく、で良いんですかね。
Jakaさんが何を指摘したいのかが、私には解りませんが、2020/09/20(日) 16:29の「実験02」を研究してみてください。
（あとコメントも読んでください）
ちなみに、オートフィルタを使う場合、最終行を取得ぜずとも処理できると思います。
■７で↓のように提示しているわけですが、
Intersect(.AutoFilter.Range, .AutoFilter.Range.Offset(1), .Range("Q:Q")).Copy
.Range("A1").PasteSpecial Paste:=xlPasteValues
おそらくは、Q列ではなくA列をコピーして、カットシートに値貼付したかったとおもうので
Intersect(.AutoFilter.Range, .AutoFilter.Range.Offset(1), .Range("A:A")).Copy
完成ファイル1.Worksheets("カット").Range("A1").PasteSpecial Paste:=xlPasteValues
とすれば完成していたんじゃないでしょうか。
2020/09/20(日) 16:29に「コピー対象の列、貼付先シートの指定がおかしかったのを除けば〜」といっているのはまさにこの部分だったわけですが・・・読んでいただけませんでしたか？
（もこな２） 2020/09/23(水) 19:06
■16
失礼しました。再度読み込み、実験03を実行してわかりました。
取得した最終行と、意図している最終行が異なるため、おかしい結果になり、理解できました。
有難うございます。
■17
記載いただいた「実験02」を研究・実行してみました。
解説までしていただいて有難うございます。
おっしゃる通り、Q列ではなくA列をコピーしたかったため、
.Range("A:A")).Copyに変更して、意図した行を可視セルのみコピーすることができました。
ちゃんと理解できておらず、申し訳ありませんでした。
（ピノ） 2020/09/23(水) 23:25
無理にとは言いませんが、仕上げとして最終的なコードを提示してもらえませんか？
当初からいくつかの変更があったとおもいますので、ちゃんと整理できているのか気になります。
（もこな２） 2020/09/24(木) 06:14
[ 一覧(最新更新順) ]
YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki.
Modified by kazu.