Excel VBA質問箱 IV

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

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


4596 / 13644 ツリー ←次へ | 前へ→

【55513】Find検索からFindNext が作動できない yukio 08/5/9(金) 10:20 質問[未読]
【55517】Re:Find検索からFindNext が作動できない ひげくま 08/5/9(金) 10:50 回答[未読]
【55531】Re:Find検索からFindNext が作動できない yukio 08/5/9(金) 19:29 お礼[未読]
【55533】Re:Find検索からFindNext が作動できない kanabun 08/5/9(金) 19:46 発言[未読]
【55541】Re:Find検索からFindNext が作動できない yukio 08/5/10(土) 14:36 お礼[未読]
【55543】Re:Find検索からFindNext が作動できない kanabun 08/5/10(土) 15:31 発言[未読]
【55703】Re:Find検索からFindNext が作動できない yukio 08/5/16(金) 11:10 お礼[未読]
【55704】Re:Find検索からFindNext が作動できない kanabun 08/5/16(金) 11:29 発言[未読]
【55714】Re:Find検索からFindNext が作動できない kanabun 08/5/16(金) 15:41 発言[未読]
【55733】Re:Find検索からFindNext が作動できない yukio 08/5/17(土) 13:44 お礼[未読]
【55735】Re:Find検索からFindNext が作動できない kanabun 08/5/17(土) 13:50 発言[未読]
【55534】Re:Find検索からFindNext が作動できない ひげくま 08/5/9(金) 19:47 発言[未読]
【55542】Re:Find検索からFindNext が作動できない yukio 08/5/10(土) 15:00 お礼[未読]
【55591】Re:Find検索からFindNext が作動できない ひげくま 08/5/12(月) 14:37 回答[未読]
【55699】Re:Find検索からFindNext が作動できない yukio 08/5/16(金) 9:12 お礼[未読]
【55705】Re:Find検索からFindNext が作動できない テト 08/5/16(金) 11:43 発言[未読]
【55737】Re:Find検索からFindNext が作動できない yukio 08/5/17(土) 14:16 お礼[未読]

【55513】Find検索からFindNext が作動できない
質問  yukio  - 08/5/9(金) 10:20 -

引用なし
パスワード
   暗中模索状態になり解決できず、皆さんのアドバイスをお願します。
2個のFind検索にしたのは、1個の場合は応用できるのではないかと考えてのですが。
(例)
   Dim MaxRows As Long
   Dim y As Integer
 Dim WorkArea As String
 Dim CellAddress As String
 Dim Result As Variant, Result2 As Variant
 Dim StrCount As String
    MaxRows = ActiveSheet.UsedRange.Rows.Count
    y = MaxRows
    WorkArea = "B1:B" & MaxRows
     Set Result = ActiveSheet.Range(WorkArea).Find(what:="果物")
   If Result Is Nothing Then
   Else
     CellAddress = Result.Address
   End If
    StrCount = Len(CellAddress)
    CellAddress = Right(CellAddress, StrCount - 3)
    WorkArea = "B" & CellAddress & ":C" & MaxRows
     Set Result2 = ActiveSheet.Range(WorkArea).Find(what:="りんご", LookAt:=xlWhole)
  
   If Result2 Is Nothing Then
   Else
    CellAddress = Result2.Address
   End If
    Do
      Set Result2 = ActiveSheet.Range(WorkArea).FindNext(Result2)
    Loop While Not Result2 Is Nothing And Result2.Address <> CellAddress
     CellAddress = Right(CellAddress, StrCount - 3)
     CellAddress = "A" & CellAddress
     ActiveSheet.Range("E2").Value = ActiveSheet.Range(CellAddress)
    
     CellAddress = Right(CellAddress, StrCount - 3)
     CellAddress = "D" & CellAddress
     ActiveSheet.Range("F2").Value = ActiveSheet.Range(CellAddress)
End sub
このコードは中途半端なものです。いろいろ試みたのですが駄目でした。
Resizeの場合、2個のFindになると出来たり出来なかったりで原因がわかりません。
もともと2個のFindからのFindNextのコード利用は無理なのでしょうか。
ご教示をお願いします。

【55517】Re:Find検索からFindNext が作動できない
回答  ひげくま  - 08/5/9(金) 10:50 -

引用なし
パスワード
   私も同じようなことをしてはまったことがありました。

FindNextは、直前に処理したFindの検索条件を覚えています。
だから、検索開始セルだけ指定すればよく、違う言い方をすれば、検索開始セルしか指定できません。

2種類の検索条件でFindNextのようなことをしたい場合は、Findで引数Afterを活用するしかないと思います。

【55531】Re:Find検索からFindNext が作動できない
お礼  yukio  - 08/5/9(金) 19:29 -

引用なし
パスワード
   ▼ひげくま さん:
早速のアドバイス有難うございます。
>Findで引数Afterを活用するしかないと思います。

この意味が理解出来ないのが、我ながら情けないところですが...
私の能力では難しいと痛感していますが...
例示のコードは、原型が複数のFindのために作成したものなので、FindNestへの応用が無理なのかも知れません。
魅力のあるコードなものですから、つい投稿したわけです。
現在、AutoFilter 機能を使っているので、私用の音楽CD管理には複数のFindもFindNextも使わずに正常に動いている状態になっています。
また、Resizeを使って試したんですが、複数のFind検索になると何故か不安定になってしまう。
複数FindからFindNextへのコード作成は難しいものなんでしょうか?

【55533】Re:Find検索からFindNext が作動できない
発言  kanabun  - 08/5/9(金) 19:46 -

引用なし
パスワード
   横からすみません。
> 例示のコードは、原型が複数のFindのために作成したものなので、
> FindNestへの応用が無理なのかも知れません。
> 魅力のあるコードなものですから、つい投稿したわけです。
コードの前に、というか、
コードというものは、やりたいことがあって、そのあとについてくるものだと
思うのですが。
いま、どういうことをしたいのですか?
たとえば、
B列から ≪果物≫を検索して、
 見つかったら、そのセル以降の B,C列の範囲から≪りんご≫を
 「すべて検索」する
---というようなことをしたいのか( ← きっとちがうと思います ^^)

おやりになりたいことを言葉で説明していただけると、
Do 〜 FindNext 〜 Loop についての是非(または修正案、代案、別解等)
についても具体的なコメントがつきそうな予感がするのですが。

【55534】Re:Find検索からFindNext が作動できない
発言  ひげくま  - 08/5/9(金) 19:47 -

引用なし
パスワード
   >>Findで引数Afterを活用するしかないと思います。
>この意味が理解出来ないのが、我ながら情けないところですが...

Findを調べてみましたか?

>複数FindからFindNextへのコード作成は難しいものなんでしょうか?

それを答えたつもりです。

【55541】Re:Find検索からFindNext が作動できない
お礼  yukio  - 08/5/10(土) 14:36 -

引用なし
パスワード
   ▼kanabun さん:
目に止めていただき有難うございます。
>いま、どういうことをしたいのですか?
>たとえば、
>B列から ≪果物≫を検索して、
> 見つかったら、そのセル以降の B,C列の範囲から≪りんご≫を
> 「すべて検索」する
>---というようなことをしたいのか( ← きっとちがうと思います ^^)

実は、「すべて検索」したいためのことなんです。
(例示)として
  A     B     C      D    E      F
1 産地    種類    品別    銘柄   産地    銘柄
2 和歌山   果物    みかん   温州        
3 北海道   果物    もも    大野        
4 岩手    野菜    なすび   盛岡        
5 青森    果物    りんご   浅虫        
6 宮城    野菜    とまと   仙台        
7 山梨    果物    みかん   甲府        
8 福島    果物    りんご   郡山        
9 和歌山   果物    みかん   温州        
10北海道   果物    りんご   函館

以上の記載をもとに、不十分ながらコードを作ったわけです。
データは増えていきますので、FindNextの利用ができないものか投稿させていただきました。
よろしくご教示の程お願います。

【55542】Re:Find検索からFindNext が作動できない
お礼  yukio  - 08/5/10(土) 15:00 -

引用なし
パスワード
   ▼ひげくま さん:
ご指示を理解できず申し訳けありません。

>>>Findで引数Afterを活用するしかないと思います。
>Findを調べてみましたか?

Findの引数として、FindNextにAfter:=result2を使用すべきとの意味なん
でしょうか?
FindNextにかかるコード全体を捉えていない状態なので時間がかかります。
よろしくお願いします。

【55543】Re:Find検索からFindNext が作動できない
発言  kanabun  - 08/5/10(土) 15:31 -

引用なし
パスワード
   ▼yukio さん:

>>いま、どういうことをしたいのですか?
>実は、「すべて検索」したいためのことなんです。
>(例示)として
>  A     B     C      D    E      F
>1 産地    種類    品別    銘柄   産地    銘柄
>2 和歌山   果物    みかん   温州        
>3 北海道   果物    もも    大野        
>4 岩手    野菜    なすび   盛岡        
>5 青森    果物    りんご   浅虫        
>6 宮城    野菜    とまと   仙台        
>7 山梨    果物    みかん   甲府        
>8 福島    果物    りんご   郡山        
>9 和歌山   果物    みかん   温州        
>10北海道   果物    りんご   函館

この表から 「種類」が「果物」で 「品別」が「りんご」の行をすべて抽出
するなら、Find〜 FindNext ではなくて

 データ > フィルタオプションの設定(AdvancedFilter)

の機能を利用すると思いますが?

【55591】Re:Find検索からFindNext が作動できない
回答  ひげくま  - 08/5/12(月) 14:37 -

引用なし
パスワード
   Findの解説をヘルプより引用

---
引数 LookIn、LookAt、SearchOrder、および MatchByte の設定は、このメソッドが使われるたびに保存されます。次にこのメソッドを使うときに、これらの引数の指定を省略すると、保存された設定が使われます。これらの引数の設定を変更すると、[検索と置換] ダイアログ ボックスに表示される設定が変わります。また、[検索と置換] ダイアログ ボックスで設定を変更すると、保存されている設定が変わります。このような設定の変更によって生じる問題を避けるためには、Find メソッドを使うたびに、これらの引数を明示的に指定します。
---

ということで、2つ目のFindを実行した時点で、1つ目のFindの設定は1つ目の設定に上書きされてしまいます。

Cells.Find What:=xxx, After:=ccc
Cells.FindNext After:=ccc
は同じ動作をします。

一方、FindNextでは、Afterしか設定できません。
なので、検索対象の異なる複数のFindに対応させることはできません。

以上を踏まえて、検索対象の異なる複数のFindに対して、それぞれFindNextと同等のことをしたい場合は、Find What:=xxx, After:=ccc で対応しましょう。

【55699】Re:Find検索からFindNext が作動できない
お礼  yukio  - 08/5/16(金) 9:12 -

引用なし
パスワード
   ▼ひげくま さん:

>検索対象の異なる複数のFindに対して、それぞれFindNextと同等のことをしたい場合は、Find What:=xxx, After:=ccc で対応しましょう。
わざわざ、ヘルプからの引用に感謝します。
 要は、Find毎にFindNext を使って対象を絞るべきものと解釈しましたが….
 そこで、今回の例示は、FindNextを使うにしてもコードをどう作っていくのか手を付けれないFindNext以前の問題になっていますので、手直しして新規に質問致しますので、よろしくお願いします。
 しかし、今回のご回答で、Resize での問題が解決できました。データの少ないサンプルでは、FindNext 1つで抽出されるのが、データの多い(それ程ではないのですが)現在利用しているファイルに適用すると全然駄目で、ずっと引きずっていました。
 有難うございました。

【55703】Re:Find検索からFindNext が作動できない
お礼  yukio  - 08/5/16(金) 11:10 -

引用なし
パスワード
   ▼kanabun さん:
    
> データ > フィルタオプションの設定(AdvancedFilter)
>の機能を利用すると思いますが?

AdvancedFilter 利用のご提案有難うございました。
初めて目にするフィルタオプションですので早速コードを作ってみました。
データの少ないサンプルでコードを作り動かしてみたら問題がなかったので、現在使っているファイルに利用したところ、項目だけが横に並ぶのですがデータが抽出されてきません。いろいろいじったのですが原因が掴めません。アドバイスをお願いいたします。
 Sub ADF抽出()
   Dim MaxRows As Long
   Dim y As Integer
  
    Worksheets("CD目録").Range("T1").Value = "種別"
    Worksheets("CD目録").Range("T2").Value = "交響曲"
    Worksheets("CD目録").Range("U1").Value = "作曲者名"
    Worksheets("CD目録").Range("U2").Value = "ハイドン"
  
   MaxRows = Sheets("CD目録").UsedRange.Rows.Count
   y = MaxRows
  
  Worksheets("仮抽出").Range("A:E").Clear

  Union(Range("E2:H2"), Range("K2")).Select
  Application.CutCopyMode = xlCut
  Selection.Copy
  Sheets("仮抽出").Select
  Range("A1").Select
  ActiveSheet.Paste
  
  Worksheets("CD目録").Range("C2:K" & y).AdvancedFilter _
     Action:=xlFilterCopy, _
     CriteriaRange:=Worksheets("CD目録").Range("T1:U2"), _
     CopyToRange:=Worksheets("仮抽出").Range("A1:E1"), _
     Unique:=False
 End Sub
   無理な注文なのかコードに間違いがあるのか分かりません。
   よろしくご指導のほどお願いします。

【55704】Re:Find検索からFindNext が作動できない
発言  kanabun  - 08/5/16(金) 11:29 -

引用なし
パスワード
   ▼yukio さん:
こんにちは。ちょっとシートレイアウトがよくわからないので、
前掲の簡単なサンプルデータで

>> データ > フィルタオプションの設定(AdvancedFilter)

を利用して、別シートに抽出するサンプルコードを書いておきます。
比べてみてください。
・変数を使って 検索条件範囲、抽出先 などをセットしている。
・Select Activate を使わない
ことなどに留意して。

>1 産地    種類    品別    銘柄   産地    銘柄
>2 和歌山   果物    みかん   温州
>3 北海道   果物    もも    大野
>4 岩手    野菜    なすび   盛岡
>5 青森    果物    りんご   浅虫
>6 宮城    野菜    とまと   仙台
>7 山梨    果物    みかん   甲府
>8 福島    果物    りんご   郡山
>9 和歌山   果物    みかん   温州
>10北海道   果物    りんご   函館

> この表から 「種類」が「果物」で 「品別」が「りんご」の行を
> すべて抽出するなら、

Sub Try1()
 Dim Trange As Range   'リスト範囲
 Dim Crange As Range   '検索条件範囲
 Dim Drange As Range   '抽出先
 
 Set Trange = Sheet1.Range("A1").CurrentRegion.Resize(, 4)
 Set Crange = Sheet2.Range("H1").Resize(2, 2)
  '種類が「果物」 品別が「りんご」の行を抽出する例です
  'ここは↓マクロでセットしてますが、 _
   あらかじめ手動で書き込んでおいてもいいです
 Crange.Value = [{"種類","品別";"果物","りんご"}]
 Set Drange = Sheet2.Range("A1")
 
 Trange.AdvancedFilter xlFilterCopy, Crange, Drange

End Sub

【55705】Re:Find検索からFindNext が作動できない
発言  テト  - 08/5/16(金) 11:43 -

引用なし
パスワード
   別案。
まぁ、AdvancedFilterの方が良いと思うけど、ベタに考えるとこんなとこ?
難しいこと考える必要もないしw

――――――――――――――――――――――――――――――
Dim lastRow As Long
Dim i As Long
Dim uRng As Range

lastRow = Range("A1").End(xlDown).Row

For i = 2 To lastRow
  With Range("B" & i)
    If .Value = "果物" And _
      .Offset(0, 1).Value = "りんご" _
    Then
      If uRng Is Nothing Then
        Set uRng = .Resize(1, 2)
      Else
        Set uRng = Union(uRng, .Resize(1, 2))
      End If
    End If
  End With
Next i

If Not uRng Is Nothing Then
  uRng.Copy Range("H2")
End If
――――――――――――――――――――――――――――――

【55714】Re:Find検索からFindNext が作動できない
発言  kanabun  - 08/5/16(金) 15:41 -

引用なし
パスワード
   ▼yukio さん:
>初めて目にするフィルタオプションですので早速コードを作ってみました。
>データの少ないサンプルでコードを作り動かしてみたら問題がなかったので、
> 現在使っているファイルに利用したところ、項目だけが横に並ぶのですが
> データが抽出されてきません。いろいろいじったのですが原因が掴めません。
> アドバイスをお願いいたします。

の件ですが、

>  Union(Range("E2:H2"), Range("K2")).Select
>  Selection.Copy

のところで、どのシートかを指定せずに範囲を選択 Copy しています
ここは、「CD目録」シートの必要見出しを「仮抽出」シートにコピーしてい
るところと思われますが、Rangeの前にシートの指定がないので、
仮にアクティブなシートが仮抽出のほうだとすると、
空白セルがコピーされます。その結果、AdvancedFilterの抽出先の
項目名が空白でエラーになります。
ま、
> 項目だけが横に並ぶのですが
ということなので ActiveSheetは「CD目録」のほうにあったのでしょうが。

あと、Copy貼り付けするときに シートの選択は不要です。
どのシートのどのセル範囲を どのシートのどこのセルに 貼り付ける
のように Selectなしで一気に書いてください。
よく言われるように、 Select Selection に頼ったコードは
画面がチラチラするし、コードの可読性も劣るので、Selectは
ほんとうにそれが必要な時以外は避けるようにしましょう。

その点を考慮して、若干修正すると以下のようですが、

Sub ADF抽出2()
 Dim MaxRows As Long

 Worksheets("仮抽出").Range("A:E").Clear
 
 With Worksheets("CD目録")
   .Range("T1").Value = "種別"
   .Range("T2").Value = "交響曲"
   .Range("U1").Value = "作曲者名"
   .Range("U2").Value = "ハイドン"
   MaxRows = .UsedRange.Rows.Count
   Union(.Range("E2:H2"), .Range("K2")).Copy _
       Sheets("仮抽出").Range("A1")

   .Range("C2:K" & MaxRows).AdvancedFilter _
     Action:=xlFilterCopy, _
     CriteriaRange:=.Range("T1:U2"), _
     CopyToRange:=Worksheets("仮抽出").Range("A1:E1")
 End With
End Sub

こちらの簡単なサンプルデータでのテストでは もともとの
yukio さんのコードでも
「交響曲」「ハイドン」はちゃんと抽出されましたから
> コードに間違いがある
のではないような気がします。
たとえば 「交響曲」「ハイドン」は完全一致で検索なんですよね?
〜が含まれる(部分一致)ではないですよね?

【55733】Re:Find検索からFindNext が作動できない
お礼  yukio  - 08/5/17(土) 13:44 -

引用なし
パスワード
   ▼kanabun さん:
解決しました。馬鹿げたことで、全く無駄な時間を使わせ申し訳なく思っております。
kanabunさんが送ってくれましたコードを利用して順次切り替えさせていただきます。(CurrentRegion の方は見送ります。)
AdvancedFilterの利用は、テトさんのコメントにもありましたが、AutoFilter や
FindNext(Resizeコード数)と比較しても効率の良さが分かります。

昨日、kabanunさんのコードで試したところ、同じように横一線の項目だけが抽出されるだけなので、あれこれ弄ってみたのですが駄目でした。
AutoFilter やFindNext を使って支障なく現在利用しているファイルだけに、こんな不思議なことがあるものかと。
今日になって、データシート(CD目録)を眺めていたのですが、ひよっとしたらという個所が、項目欄の“種 別”の文字、間にスペースが入っていたので削除したら、すべてが解決しました。
いままで気に留めていなかった盲点でした。CriteriaRange が絡んでいたんですね。
まことに有難うございました。VBAでの解決は嬉しいものですね。
今後もご教示を求めることがあると思います。よろしくお願いいたします。

【55735】Re:Find検索からFindNext が作動できない
発言  kanabun  - 08/5/17(土) 13:50 -

引用なし
パスワード
   ▼yukio さん:

>今日になって、データシート(CD目録)を眺めていたのですが、ひよっとしたらという個所が、項目欄の“種 別”の文字、間にスペースが入っていたので削除したら、すべてが解決しました。
>いままで気に留めていなかった盲点でした。CriteriaRange が絡んでいたんですね。

おめでとうございます。
原因をご自分で発見されたときの喜びは、また格別でしょう。
こちらもうれしいです♪

【55737】Re:Find検索からFindNext が作動できない
お礼  yukio  - 08/5/17(土) 14:16 -

引用なし
パスワード
   ▼テト さん:
>まぁ、AdvancedFilterの方が良いと思うけど、
 
ご提案有難うございます。
ハイカラで軽快なコードですね。
AdvancedFilter の処理が終わってからテトさんのコード
をトライしたいと思っています。
その節は、よろしくご指導よろしくお願いします。

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