VBA 特定の行だけ取り出す方法

こんにちは。

VBAで特定のデータを取り出したいのですが、
作業としては
1.アクティブシートをコピーし新しいシートの名前を"補充治具費"にする。
2.AD列が治具費かつAB列に入力されているものが　"J"　"JB"　"JD"　"W"　
　で始まっていなければ行ごと削除する。("J"　"JB"　"JD"　"W"の4種類だけ残す)
3.２を一番下の行まで繰り返す

大きく３つですが、AB列にはJBとJBNで始まるものがあり,必要なのはJBだけです。

よろしくお願いします。

No.1 回答者： TH69 回答日時： 2017/07/13 22:18

> "J"　"JB"　"JD"　"W"　で始まっていなければ

という事ですが、"J" と "W" で始まっているものはすべて残す、という意味でしょうか？

> JBとJBNで始まるものがあり,必要なのはJBだけ

"JB" で始まっているものを残せば、"JBN" も必ず残りますが…？

その辺りについて、もう少し詳しく教えて頂きたいと思います。

No.2 ベストアンサー 回答者： WindFaller 回答日時： 2017/07/16 22:48

一応、こちらについても回答させていただきます。

何度かこの似た質問が出ていたようですが、これについては、プロセスそのものは回答者にお任せになってください。
しかし、どうも正確なロジックが読みきれません。

"J"　"JB"　"JD"　"W"　
ワイルドカード式ではなくて、
AB列
JB　でなおかつJBNではない、JD または、W

AD列は、
JB　か　JD または、W

ということではありませんか？そもそも、Jで始まる条件というものはなさそうです。

この意味が分かるでしょうか？
=SUMPRODUCT((LEFT(AB2,2)={"JB";"JD"})*(LEFT(AB2,3)<>"JBN")+(LEFT(AB2,1)="W"))
+SUMPRODUCT((LEFT(AD2,2)={"JB";"JD"})+(LEFT(AD2,1)="W"))

AB列は、JB, JD であるが、JBNではない。または、W
AD列は、JB, JD または、W

というクライテリアで出来ています。
数式さえ分かれば、ご自分でも、調整できるはずです。
また、補充治具費の部分は、シートがすでにある場合は、新しいシートに変わります。

'//標準モジュール
Sub PicupDATA()
Dim AcSh As Worksheet
Dim NewSh As Worksheet
Dim Rng As Range
Dim CriteArea As Range
Const FML As String = "=SUMPRODUCT((LEFT(AB2,2)={""JB"";""JD""})*(LEFT(AB2,3)<>""JBN"")+(LEFT(AB2,1)=""W""))+SUMPRODUCT((LEFT(AD2,2)={""JB"";""JD""})+(LEFT(AD2,1)=""W""))>0"
Set AcSh = ActiveSheet
Set NewSh = Worksheets.Add(After:=Worksheets(Worksheets.Count))
On Error Resume Next
NewSh.Name = "補充治具費"
On Error GoTo 0
With AcSh
　If .FilterMode Then
　.ShowAllData
　End If
　Set Rng = .Range("A1").CurrentRegion
　Set CriteArea = .Cells(1, Columns.Count).End(xlToLeft).Offset(, 1).Resize(2)
　CriteArea.Cells(2, 1).FormulaLocal = FML
　Rng.AdvancedFilter Action:=xlFilterCopy, _
　　　　　　 CriteriaRange:=CriteArea, _
　　　　　　 CopytoRange:=NewSh.Range("A1"), _
　　　　　　 Unique:=False
End With
　NewSh.Activate
End Sub