Excel VBA質問箱 IV

当質問箱は、有志のボランティア精神のおかげで成り立っています。
問題が解決したら、必ずお礼をしましょうね。
本サイトの基本方針をまとめました。こちら をご一読ください。

投稿種別の選択が必要です。ご注意ください。
迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。


3921 / 13646 ツリー ←次へ | 前へ→

【59281】オートフィルターの繰り返し フィルター 08/12/4(木) 17:15 質問[未読]
【59282】Re:オートフィルターの繰り返し kanabun 08/12/4(木) 17:20 発言[未読]
【59284】Re:オートフィルターの繰り返し kanabun 08/12/4(木) 20:00 発言[未読]
【59417】Re:オートフィルターの繰り返し フィルター 08/12/10(水) 16:48 お礼[未読]
【59447】Re:オートフィルターの繰り返し フィルター 08/12/11(木) 15:29 質問[未読]
【59452】Re:オートフィルターの繰り返し kanabun 08/12/11(木) 17:24 発言[未読]
【59454】Re:オートフィルターの繰り返し フィルター 08/12/11(木) 17:45 お礼[未読]
【59455】Re:オートフィルターの繰り返し フィルター 08/12/11(木) 18:53 質問[未読]
【59484】Re:オートフィルターの繰り返し pico 08/12/12(金) 22:17 発言[未読]
【59485】Re:オートフィルターの繰り返し かみちゃん 08/12/12(金) 22:40 発言[未読]
【59490】Re:オートフィルターの繰り返し kanabun 08/12/13(土) 9:54 発言[未読]
【59497】Re:オートフィルターの繰り返し pico 08/12/13(土) 20:28 発言[未読]

【59281】オートフィルターの繰り返し
質問  フィルター  - 08/12/4(木) 17:15 -

引用なし
パスワード
   先輩方、お疲れ様です。オートフィルターの繰り返しについて質問します。
まずは構文です。TextBox76に文字を入れてあいまい検索を実施する物です。
そして4行目にあるデータをあいまい検索しています。
その後、リストボックスに検索後の対象データを表示させます。

Private Sub CommandButton110_Click()

Dim myRow As Long
   With Application.WorksheetFunction
     If .CountIf(Worksheets("DATA").Range("A2:K2500"), Me.TextBox76.Text) > 0 Then
    
    
       With Worksheets("WAREA")
       Intersect(.UsedRange, .Columns("A:CD")).ClearContents
       End With
       Worksheets("DATA").Range("A1:K2500").AutoFilter 4, "=*" & UserForm2.TextBox76.Value & "*"

       Worksheets("DATA").Range("A1").CurrentRegion.Copy Destination:=Worksheets("WAREA").Range("A1")
      
       Worksheets("DATA").Range("A1").AutoFilter
     Else
       Exit Sub: Rem ComboBoxにリストに対する値がなかった場合の処理
     End If
   End With
  
  
With Worksheets("WAREA")
 IRow = .Range("A" & Rows.Count).End(xlUp).Row + 1
End With

With ListBox1
.ColumnHeads = True
.ColumnCount = 11
.ColumnWidths = "30;80;55;60;60;60;65;45;45;45;25;"
'.Text = "DATA!A2:K500"
.RowSource = "WAREA!A2:K2500"

End With
End Sub

ここで
Worksheets("DATA").Range("A1:K2500").AutoFilter 4, "=*" & UserForm2.TextBox76.Value & "*"

4行目を検索していますが、4行目を検索して次に6行目を同様に検索する場合は
4行目終了→6行目のような繰り返しをどの様な構文を作成すればよいでしょうか
よろしくご指導お願いします。

【59282】Re:オートフィルターの繰り返し
発言  kanabun  - 08/12/4(木) 17:20 -

引用なし
パスワード
   > 4行目を検索して次に6行目

4行目 というのは 4列目?

【59284】Re:オートフィルターの繰り返し
発言  kanabun  - 08/12/4(木) 20:00 -

引用なし
パスワード
   AutoFilterで、複数列(4列目と6列目)を抽出コピーだと、
4列目をAutoFilterかけて転記してから、いったん.AutoFilter解除して、
改めて 6列目にフィルタかけ、最初に転記したデータのあとに追加する
ということになり、手間が増えるので、

同じフィルタでもフィルタオプションによる抽出コピーのほうが
簡単で速そうです。

Private Sub CommandButton110_Click()
  Dim ss As String
  Dim fRange As Range
  Dim cRange As Range
  Dim CopyTo As Range
  Dim s1 As String, s2 As String
  
  ss = TextBox76.Text
  ss = "*" & ss & "*"
  With Worksheets("DATA")
    Set fRange = .Range("A1").CurrentRegion 'フィルタ範囲
    Set cRange = .Range("AA1") '抽出条件範囲先頭セル
    s1 = .Range("D1").Value   'D列見出し
    s2 = .Range("F1").Value   'F列見出し
  End With
  If WorksheetFunction.CountIf(fRange.Columns("D:F"), ss) > 0 Then
     Set CopyTo = Worksheets("WAREA")
     CopyTo.Parent.UsedRange.ClearContents
     'cRange に抽出条件をセット
     cRange.CurrentRegion.ClearContents
     cRange(1, 1).Value = s1
     cRange(1, 2).Value = s2
     cRange(2, 1).Value = "'=" & ss
     cRange(3, 2).Value = "'=" & ss
     'フィルタオプションによる抽出コピーの実行
     fRange.AdvancedFilter xlFilterCopy, _
       CriteriaRange:=cRange.CurrentRegion, _
        CopyToRange:=CopyTo
  End If
 
End Sub

【59417】Re:オートフィルターの繰り返し
お礼  フィルター  - 08/12/10(水) 16:48 -

引用なし
パスワード
   ▼kanabun さん:
>AutoFilterで、複数列(4列目と6列目)を抽出コピーだと、
>4列目をAutoFilterかけて転記してから、いったん.AutoFilter解除して、
>改めて 6列目にフィルタかけ、最初に転記したデータのあとに追加する
>ということになり、手間が増えるので、
>
>同じフィルタでもフィルタオプションによる抽出コピーのほうが
>簡単で速そうです。
>
>Private Sub CommandButton110_Click()
>  Dim ss As String
>  Dim fRange As Range
>  Dim cRange As Range
>  Dim CopyTo As Range
>  Dim s1 As String, s2 As String
>  
>  ss = TextBox76.Text
>  ss = "*" & ss & "*"
>  With Worksheets("DATA")
>    Set fRange = .Range("A1").CurrentRegion 'フィルタ範囲
>    Set cRange = .Range("AA1") '抽出条件範囲先頭セル
>    s1 = .Range("D1").Value   'D列見出し
>    s2 = .Range("F1").Value   'F列見出し
>  End With
>  If WorksheetFunction.CountIf(fRange.Columns("D:F"), ss) > 0 Then
>     Set CopyTo = Worksheets("WAREA")
>     CopyTo.Parent.UsedRange.ClearContents
>     'cRange に抽出条件をセット
>     cRange.CurrentRegion.ClearContents
>     cRange(1, 1).Value = s1
>     cRange(1, 2).Value = s2
>     cRange(2, 1).Value = "'=" & ss
>     cRange(3, 2).Value = "'=" & ss
>     'フィルタオプションによる抽出コピーの実行
>     fRange.AdvancedFilter xlFilterCopy, _
>       CriteriaRange:=cRange.CurrentRegion, _
>        CopyToRange:=CopyTo
>  End If
> 
>End Sub

返事が遅れすいませんです。風邪で昨日まで休みを取っていました。

Private Sub CommandButton110_Click()
  Dim ss As String
  Dim fRange As Range
  Dim cRange As Range
  Dim CopyTo As Range
  Dim s1 As String, s2 As String
  
  ss = TextBox76.Text
  ss = "*" & ss & "*"
  With Worksheets("DATA")
    Set fRange = .Range("A1").CurrentRegion 'フィルタ範囲
    Set cRange = .Range("AA1") '抽出条件範囲先頭セル
    s1 = .Range("D1").Value   'D列見出し
    s2 = .Range("F1").Value   'F列見出し
  End With
  If WorksheetFunction.CountIf(fRange.Columns("D:F"), ss) > 0 Then
     Set CopyTo = Worksheets("WAREA")
     CopyTo.Parent.UsedRange.ClearContents
     'cRange に抽出条件をセット
     cRange.CurrentRegion.ClearContents
     cRange(1, 1).Value = s1
     cRange(1, 2).Value = s2
     cRange(2, 1).Value = "'=" & ss
     cRange(3, 2).Value = "'=" & ss
     'フィルタオプションによる抽出コピーの実行
     fRange.AdvancedFilter xlFilterCopy, _
       CriteriaRange:=cRange.CurrentRegion, _
        CopyToRange:=CopyTo
  End If
 
End Sub

ご指導、ありがとうございます。
また。複数行検索するには単純に
s1 = .Range("D1").Value   'D列見出し
    s2 = .Range("F1").Value   'F列見出し
  End With
  If WorksheetFunction.CountIf(fRange.Columns("D:F"), ss) > 0 Then

の部分でD1、F1、・・(”D:F:・・・)と増やすだけでよろしいでしょうか?
お礼が質問になってしまいましたがよろしくお願いします。

【59447】Re:オートフィルターの繰り返し
質問  フィルター  - 08/12/11(木) 15:29 -

引用なし
パスワード
   kanabun さん:
また質問ですいませんです。

>>AutoFilterで、複数列(4列目と6列目)を抽出コピーだと、
>>4列目をAutoFilterかけて転記してから、いったん.AutoFilter解除して、
>>改めて 6列目にフィルタかけ、最初に転記したデータのあとに追加する
>>ということになり、手間が増えるので、
>>
>>同じフィルタでもフィルタオプションによる抽出コピーのほうが
>>簡単で速そうです。
>>
>>Private Sub CommandButton110_Click()
>>  Dim ss As String
>>  Dim fRange As Range
>>  Dim cRange As Range
>>  Dim CopyTo As Range
>>  Dim s1 As String, s2 As String
>>  
>>  ss = TextBox76.Text
>>  ss = "*" & ss & "*"
>>  With Worksheets("DATA")
>>    Set fRange = .Range("A1").CurrentRegion 'フィルタ範囲
>>    Set cRange = .Range("AA1") '抽出条件範囲先頭セル
>>    s1 = .Range("D1").Value   'D列見出し
>>    s2 = .Range("F1").Value   'F列見出し
>>  End With
>>  If WorksheetFunction.CountIf(fRange.Columns("D:F"), ss) > 0 Then
>>     Set CopyTo = Worksheets("WAREA")
>>     CopyTo.Parent.UsedRange.ClearContents
>>     'cRange に抽出条件をセット
>>     cRange.CurrentRegion.ClearContents
>>     cRange(1, 1).Value = s1
>>     cRange(1, 2).Value = s2
>>     cRange(2, 1).Value = "'=" & ss
>>     cRange(3, 2).Value = "'=" & ss
>>     'フィルタオプションによる抽出コピーの実行
>>     fRange.AdvancedFilter xlFilterCopy, _
>>       CriteriaRange:=cRange.CurrentRegion, _
>>        CopyToRange:=CopyTo
>>  End If
>> 
>>End Sub
>
>返事が遅れすいませんです。風邪で昨日まで休みを取っていました。
>
>Private Sub CommandButton110_Click()
>  Dim ss As String
>  Dim fRange As Range
>  Dim cRange As Range
>  Dim CopyTo As Range
>  Dim s1 As String, s2 As String
>  
>  ss = TextBox76.Text
>  ss = "*" & ss & "*"
>  With Worksheets("DATA")
>    Set fRange = .Range("A1").CurrentRegion 'フィルタ範囲
>    Set cRange = .Range("AA1") '抽出条件範囲先頭セル
>    s1 = .Range("D1").Value   'D列見出し
>    s2 = .Range("F1").Value   'F列見出し
>  End With
>  If WorksheetFunction.CountIf(fRange.Columns("D:F"), ss) > 0 Then
>     Set CopyTo = Worksheets("WAREA")
>     CopyTo.Parent.UsedRange.ClearContents
>     'cRange に抽出条件をセット
>     cRange.CurrentRegion.ClearContents
>     cRange(1, 1).Value = s1
>     cRange(1, 2).Value = s2
>     cRange(2, 1).Value = "'=" & ss
>     cRange(3, 2).Value = "'=" & ss
>     'フィルタオプションによる抽出コピーの実行
>     fRange.AdvancedFilter xlFilterCopy, _
>       CriteriaRange:=cRange.CurrentRegion, _
>        CopyToRange:=CopyTo
>  End If
> 
>End Sub
>

また、質問ですいません
分からないところがあるのでご指導お願いします

     'cRange に抽出条件をセット
     cRange.CurrentRegion.ClearContents
     cRange(1, 1).Value = s1
     cRange(1, 2).Value = s2
ですが、(1,1)は1行目1列から検索という意味でしょうか・・?
また同様に
cRange(2, 1).Value = "'=" & ss
は2行目1列目から検索という意味でしょうか?
ご指導お願いします。
ちなみに検索対象データは2列目からになります。
何度もすいません。

【59452】Re:オートフィルターの繰り返し
発言  kanabun  - 08/12/11(木) 17:24 -

引用なし
パスワード
   ▼フィルター さん:

> 分からないところがあるのでご指導お願いします
>
>      'cRange に抽出条件をセット
>      cRange.CurrentRegion.ClearContents
>      cRange(1, 1).Value = s1
>      cRange(1, 2).Value = s2
> ですが、(1,1)は1行目1列から検索という意味でしょうか・・?

はい。まず、範囲 cRange は
>    Set cRange = .Range("AA1") '抽出条件範囲先頭セル
セル[AA1]のことです。
>      cRange(1, 1).Value = s1
>      cRange(1, 2).Value = s2
とは、
   [AA1]を基点として相対セル位置(1行目、1列目)のセルに
     すなわち [AA1]セルに D列見出しをセットし、
   [AA1]を基点とした(1行目、2列目)のセルに
      すなわち[AB1]セルに F列見出しをセットする、
ということです。

理解するために、まず手動でフィルタオプションをやってみることをお勧めします。
フィルタオプションの抽出条件のセル範囲への書き方は
ここを参考にしてください。

ht tp://www11.plala.or.jp/koma_Excel/contents6/mame6043/mame604301.html
フィルタオプション(いろいろな検索条件の指定方法)
の中段あたりに

3.複数の列の別々の行に抽出条件を指定する
→いずれかに一致するデータが抽出(OR条件)
の書き方の例が載っていますが、これと同じことをしているわけです。

【59454】Re:オートフィルターの繰り返し
お礼  フィルター  - 08/12/11(木) 17:45 -

引用なし
パスワード
   ▼kanabun さん:
ご指導、ありがとうございます。
URL見てみます。分からないようでしたら再度質問いたしますので
ご指導願いします。


>▼フィルター さん:
>
>> 分からないところがあるのでご指導お願いします
>>
>>      'cRange に抽出条件をセット
>>      cRange.CurrentRegion.ClearContents
>>      cRange(1, 1).Value = s1
>>      cRange(1, 2).Value = s2
>> ですが、(1,1)は1行目1列から検索という意味でしょうか・・?
>
>はい。まず、範囲 cRange は
>>    Set cRange = .Range("AA1") '抽出条件範囲先頭セル
>セル[AA1]のことです。
>>      cRange(1, 1).Value = s1
>>      cRange(1, 2).Value = s2
>とは、
>   [AA1]を基点として相対セル位置(1行目、1列目)のセルに
>     すなわち [AA1]セルに D列見出しをセットし、
>   [AA1]を基点とした(1行目、2列目)のセルに
>      すなわち[AB1]セルに F列見出しをセットする、
>ということです。
>
>理解するために、まず手動でフィルタオプションをやってみることをお勧めします。
>フィルタオプションの抽出条件のセル範囲への書き方は
>ここを参考にしてください。
>
>ht tp://www11.plala.or.jp/koma_Excel/contents6/mame6043/mame604301.html
>フィルタオプション(いろいろな検索条件の指定方法)
>の中段あたりに
>
>3.複数の列の別々の行に抽出条件を指定する
> →いずれかに一致するデータが抽出(OR条件)
>の書き方の例が載っていますが、これと同じことをしているわけです。

【59455】Re:オートフィルターの繰り返し
質問  フィルター  - 08/12/11(木) 18:53 -

引用なし
パスワード
   >▼kanabun さん:
>ご指導、ありがとうございます。
URL見て直しましたがうまく動作しませんでした。
何度も質問、ご指導すいませんです。
最終的な条件は
列はF・L・R・X・AD・AJの6列で
2行目から500行まで検索対象データが入っています。
検索後リストボックスに表示するようにしています。
”構文”は・・
Private Sub CommandButton42_Click()
  Dim ss As String
  Dim fRange As Range
  Dim cRange As Range
  Dim CopyTo As Range
  Dim s1 As String, s2 As String, s3 As String, s4 As String, s5 As String, s6 As String
 
  ss = TextBox50.Text
  ss = "*" & ss & "*"
  With Worksheets("DATA")
    Set fRange = .Range("A1").CurrentRegion 'フィルタ範囲
    Set cRange = .Range("AO1") '抽出条件範囲先頭セル
    s1 = .Range("F1").Value   'F列見出し
    s2 = .Range("L1").Value   'L列見出し
    s3 = .Range("R1").Value   'R列見出し
    s4 = .Range("X1").Value   'X列見出し
    s5 = .Range("AD1").Value   'AD列見出し
    s6 = .Range("AJ1").Value   'AJ列見出し
  End With
  If WorksheetFunction.CountIf(fRange.Columns("F:L:R:X:AD:AJ"), ss) > 0 Then
     Set CopyTo = Worksheets("WAREA")
     CopyTo.Parent.UsedRange.ClearContents
     'cRange に抽出条件をセット
     cRange.CurrentRegion.ClearContents
     cRange(1, 1).Value = s1
     cRange(1, 2).Value = s2
     cRange(1, 3).Value = s3
     cRange(1, 4).Value = s4
     cRange(1, 5).Value = s5
     cRange(1, 6).Value = s6
     cRange(2, 1).Value = "'=" & ss
     cRange(3, 2).Value = "'=" & ss
     cRange(4, 3).Value = "'=" & ss
     cRange(5, 4).Value = "'=" & ss
     cRange(6, 5).Value = "'=" & ss
     cRange(7, 6).Value = "'=" & ss
    
     'フィルタオプションによる抽出コピーの実行
     fRange.AdvancedFilter xlFilterCopy, _
       CriteriaRange:=cRange.CurrentRegion, _
        CopyToRange:=CopyTo
  End If


With Worksheets("WAREA")
 IRow = .Range("A" & Rows.Count).End(xlUp).Row + 1
End With

With ListBox1
.ColumnHeads = True
.ColumnCount = 11
.ColumnWidths = "30;80;55;60;60;60;65;45;45;45;25;"
'.Text = "DATA!A2:K500"
.RowSource = "WAREA!A2:K2500"

End With
End Sub
と書きましたが、実行すると、
実行時エラー13 型が一致しませんと表示され
If WorksheetFunction.CountIf(fRange.Columns("F:L:R:X:AD:AJ"), ss) > 0 Thenの部分が黄色くなります。

どの用に対処、修正すればいいでしょうか?重ね重ねすいません。
よろしくご指導お願いいたします。

【59484】Re:オートフィルターの繰り返し
発言  pico  - 08/12/12(金) 22:17 -

引用なし
パスワード
   ▼フィルター さん:
横からすみません…質問させていただいてもよろしいでしょうか?
問題がありましたら無視してください。

kanabun様、いつも見させていただいています。
今回のご回答も
興味を持ってみさせていただいています。

フィルターさんの最初の質問ですが
小生も、小生なりに動作させて見ましたが、
ご回答の内容で動作させますと、エラーが出ました。
ここで質問ですが・・・

質問1
コードについて
Set CopyTo = Worksheets("WAREA")では、エラーが出るので
Set CopyTo = Worksheets("WAREA").Range("A1")にすると
抽出した行がWorksheets("WARA")の2行目に貼り付けられます。
これで間違いないでしょうか?

質問2
CopyTo.Parent.UsedRange.ClearContents
「Parent」が指定されたオブジェクトの親オブジェクトを返す
ことだと判断していますが、このコードはどのような
役割をしているのでしょうか?

【59485】Re:オートフィルターの繰り返し
発言  かみちゃん E-MAIL  - 08/12/12(金) 22:40 -

引用なし
パスワード
   こんにちは。かみちゃん です。

横から失礼します。

>質問1
>コードについて
>Set CopyTo = Worksheets("WAREA")では、エラーが出るので
>Set CopyTo = Worksheets("WAREA").Range("A1")にすると
>抽出した行がWorksheets("WARA")の2行目に貼り付けられます。
>これで間違いないでしょうか?

kanabunさんからコメントがつくとは思いますが、
たしかに
Dim CopyTo As Range
としている以上、
Set CopyTo = Worksheets("WAREA")
は、エラーが出ると思います。
kanabunさん、違っていれば、ご指摘ください。

そのため、
Set CopyTo = Worksheets("WAREA").Range("A1")
とすると、
フィルタオプション(AdvancedFilter)を使っている以上、指定されたセル範囲
の次の行に転記されます。
なお、フィルタオプションを使うときは、見出し行をきちんと指定しておくこと
が重要になります。

>質問2
>CopyTo.Parent.UsedRange.ClearContents
>「Parent」が指定されたオブジェクトの親オブジェクトを返す
>ことだと判断していますが、このコードはどのような
>役割をしているのでしょうか?

MsgBox CopyTo.Parent.Name
で、CopyToのセル範囲があるシートの名前になります。
つまり、
CopyTo.Parent.UsedRange
で、CopyToのセル範囲のシートのUsedRangeになります。

詳しくは、ヘルプで確認してみてください。

【59490】Re:オートフィルターの繰り返し
発言  kanabun  - 08/12/13(土) 9:54 -

引用なし
パスワード
   ▼pico さん:
>
>kanabun様、いつも見させていただいています。
>今回のご回答も
>興味を持ってみさせていただいています。
>
>フィルターさんの最初の質問ですが
>小生も、小生なりに動作させて見ましたが、
>ご回答の内容で動作させますと、エラーが出ました。
>ここで質問ですが・・・


>>--------------------------------------------------
>質問1
>コードについて
>Set CopyTo = Worksheets("WAREA")では、エラーが出るので
>Set CopyTo = Worksheets("WAREA").Range("A1")にすると
>抽出した行がWorksheets("WARA")の2行目に貼り付けられます。
>これで間違いないでしょうか?

すでに かみちゃんさんがフォローがありますとおり、
> Dim CopyTo As Range
変数 CopyTo は 抽出転記先の先頭セルのことです。
そこは おっしゃるように、
>Set CopyTo = Worksheets("WAREA").Range("A1")にする
のが正解です。コード編集時のうっかりミスでした。

>>--------------------------------------------------
>質問2
>CopyTo.Parent.UsedRange.ClearContents
>「Parent」が指定されたオブジェクトの親オブジェクトを返す
>ことだと判断していますが、このコードはどのような
>役割をしているのでしょうか?

ここも、おっしゃる通りです。
役割というか、Parentプロパティを使うメリットは、
>Set CopyTo = Worksheets("WAREA").Range("A1")
とした時点で、セルCopyTo のシートは「WAREA」シートである、
という情報が備わっているので、
CopyTo.Parent と書いておけば、シート名("WAREA")が変わったとき
最初の
>Set CopyTo = Worksheets("WAREA").Range("A1")
を変更するだけで、何か所もシート名を書き換える必要がなくなる
ということです。
補足ですが、あるセルの親であるワークシートへの参照は
 セル範囲.Parent とも、
 セル範囲.Worksheet とも書けます。


なお、本スレッドそのものは、
 
【59463】アドバンスフィルターの使い方について

のほうで、その後展開されています。

【59497】Re:オートフィルターの繰り返し
発言  pico  - 08/12/13(土) 20:28 -

引用なし
パスワード
   ▼kanabun さん かみちゃん さん:picoです

お二人の素晴らしい解説・アドバイス有難うございました。
勉強になりました。

これからもよろしくお願いします。

>なお、本スレッドそのものは、
> 【59463】アドバンスフィルターの使い方について
>のほうで、その後展開されています。

有難うございます、アドバンスフィルターの勉強をさせていただきます。
ボヤットですがDictionaryで出来ないかな?なんて
考えておりました。

本当に有難うございます。

3921 / 13646 ツリー ←次へ | 前へ→
ページ:  ┃  記事番号:
2610219
(SS)C-BOARD v3.8 is Free