[[20061010125017]]　『AdvancedFilterの検索条件記述について』（かめ）　ページの最後に飛ぶ

『AdvancedFilterの検索条件記述について』（かめ）

 以下のようなコードでAdvancedFilterで抽出を行なっています。
 抽出の条件としてはＡ列のデータの１桁目が４未満で　なおかつ
 Ｂ列のデータの２桁目が３より小さいものです。
 CriteriaRangeで定義する条件なんですか　
 もっと簡単に条件を記述する方法はないのでしょうか？
 たとえば Right(.Range("A:A"),1)<4 みたいな・・・・。
 現状でも正しく動作はしますが　記述をもっと簡単にしたい
 と思いまして 質問させていただきます。
 Sub Test()
 Dim myRng1 As Range
 Dim myRng2 As Range
 Dim myShi1 As Worksheet
 Dim myShi2 As Worksheet

 Set myShi1 = Worksheets("sheet1")
 Set myShi2 = Worksheets("Sheet2")
 myShi2.Cells.ClearContents

 With myShi1
    Set myRng1 = .Range(.Range("A1"), .Range("A65536").End(xlUp).Offset(0, 1))
    myShi2.Range("A1:B1").Value = .Range("A1:B1").Value
 End With

 '検索ｴﾘｱ値ｾｯﾄ
 With myShi2
       .Range("a2").Value = "1*"
       .Range("b2").Value = "?1*"
       .Range("a3").Value = "1*"
       .Range("b3").Value = "?2*"

       .Range("a4").Value = "2*"
       .Range("b4").Value = "?1*"
       .Range("a5").Value = "2*"
       .Range("b5").Value = "?2*"

       .Range("a6").Value = "3*"
       .Range("B6").Value = "?1*"
       .Range("a7").Value = "3*"
       .Range("B7").Value = "?2*"    
       Set myRng2 = .Range("A1:B7")

 End With
 myRng1.AdvancedFilter Action:=xlFilterCopy, _
    CriteriaRange:=myRng2, CopyToRange:=myShi2.Range("A10")

 Sheet2のA1:A2を入力しないで、
 A2に=LEFT(Sheet1!A2)<"4"、
 B2に=MID(Sheet1!B2,2,1)<"3"。
 検索条件をSheet2!A1:B2。

 または、A1を未入力で、
 A1に=AND(LEFT(Sheet1!A2)<"4",MID(Sheet1!B2,2,1)<"3")。
 検索条件をSheet2!A1:A2。

 などとは、できるようですね。　　　　　　　　　　　　　　　　　　　(LOOKUP)

 (LOOKUP)様

 お返事ありがとうございます。
 >Sheet2のA1:A2を入力しないで
 のコメントはSheet1の見出し行のフィールド名を
 持ってこないという意味ですか？
 上記のコードで
 myShi2.Range("A1:B1").Value = .Range("A1:B1").Value
 の部分を実行しないということでしょうか？
 また > A2に=LEFT(Sheet1!A2)<"4"、
      > B2に=MID(Sheet1!B2,2,1)<"3"。　
 とういう部分を
　
       With myShi2
       .Range("a2").Formula = "=Left(Sheet1!a2, 1) < 4"
       .Range("b2").Formula = "=Mid(Sheet1!b2, 2, 1) < 3"
       Set myRng2 = .Range("A1:B2")
 と記述すると4,3の判読結果がうまくいきません。ご提示の式では
 文字列扱いで判断されているのに私のほうでは数値判断してしまって
 いるからだと思い
       .Range("a2").Formula = "=Left(Sheet1!a2, 1) < '4'"
       .Range("b2").Formula = "=Mid(Sheet1!b2, 2, 1) < '3'"

 とやると「アプリケーション定義またはオブジェクト定義のエラーです」
 となってしまいます。　ご提示戴いた式をVBA上では　どう記述したら
 いいのでしょうか？　お手数を煩わせ申し訳ありませんが　よろしく
 お願いいたします。　（かめ）

Sub Test()

 Dim myLen As Long
 Const myR = "123456789"
 MsgBox Right(myR, 1)
 myLen = Len(myR)
 MsgBox Mid(myR, myLen - 1, 1)
 End Sub

 参考になりませんか？？
 ((0))

 大変申し訳ありません。 回答の記載に誤りがあります。

 検索条件範囲は、Sheet1の方に設定してください。ご不満かもしれません。
 マクロの記録で作成したものですが、このようになります。　　　　　　　　　　(LOOKUP)

 Sub Macro5()
     Sheets("Sheet1").Range("C2").Formula = "=LEFT(A2)<""4"""
     Sheets("Sheet1").Range("D2").Formula = "=MID(B2,2,1)<""3"""
     Sheets("Sheet2").Range("A10").Value = Sheets("Sheet1").Range("A1").Value
     Sheets("Sheet1").Range("A:B").AdvancedFilter Action:=xlFilterCopy, _
     CriteriaRange:=Sheets("Sheet1").Range("C1:D2"), _
     CopyToRange:=Sheets("Sheet2").Range("A10"), Unique:=False
 End Sub

 (LOOKUP)様　((0))様

 おかげ様で出来ました。下記のようにコードを
 すっきりとさせることができました。

 数式で検索範囲の設定が出来ることが
 わかって　今後AdvancedFilterの活用が増えそうです。
 お忙しい中 何度も対応いただき本当にありがとう
 ございました。（かめ）

 Sub Test()
 Dim myRng1 As Range
 Dim myRng2 As Range
 Dim myShi1 As Worksheet
 Dim myShi2 As Worksheet
 Dim Sh1Data As String
 Dim Sh2Data As String

 Set myShi1 = Worksheets("Sheet1")
 Set myShi2 = Worksheets("Sheet2")
 Set myRng1 = myShi1.Range("A:B")
      With myShi2
       .Range("a2").Formula = "=Left(sheet1!a2, 1) < ""4"""

       .Range("b2").Formula = "=Mid(sheet1!b2, 2, 1) <""3"""

       Set myRng2 = myShi2.Range("A1:B2")
       End With

 myRng1.AdvancedFilter Action:=xlFilterCopy, _
    CriteriaRange:=myRng2, CopyToRange:=myShi2.Range("A10")

 End Sub

 エクセル９７の場合ですが、 検索条件範囲は、データのあるSheet1の方に設定しないと、
 抽出が成功しないように思います。　　　　　　　　　　　　　　　　　　　　　　(LOOKUP)

コメント返信：

[ 一覧(最新更新順) ]

[[20061010125017]] 『AdvancedFilterの検索条件記述について』（かめ） ページの最後に飛ぶ

[[20061010125017]]　『AdvancedFilterの検索条件記述について』（かめ）　ページの最後に飛ぶ