Excel VBA質問箱 IV

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

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


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

【63957】Findについて きくと 10/1/4(月) 0:17 質問[未読]
【63958】Re:Findについて かみちゃん 10/1/4(月) 5:38 発言[未読]
【63959】Re:Findについて kanabun 10/1/4(月) 10:22 発言[未読]
【64002】Re:Findについて きくと 10/1/9(土) 19:50 発言[未読]
【64005】Re:Findについて かみちゃん 10/1/9(土) 21:19 発言[未読]
【64006】Re:Findについて kanabun 10/1/9(土) 21:27 発言[未読]
【64007】Re:Findについて kanabun 10/1/9(土) 21:33 発言[未読]
【64008】Re:Findについて かみちゃん 10/1/9(土) 21:44 発言[未読]
【64010】Re:Findについて kanabun 10/1/9(土) 22:33 発言[未読]
【64011】Re:Findについて かみちゃん 10/1/9(土) 22:39 発言[未読]
【64013】Re:Findについて kanabun 10/1/9(土) 22:51 発言[未読]
【64015】Re:Findについて かみちゃん 10/1/9(土) 23:13 発言[未読]
【64012】Re:Findについて kanabun 10/1/9(土) 22:48 発言[未読]
【64029】Re:Findについて きくと 10/1/10(日) 20:07 お礼[未読]
【64030】Re:Findについて kanabun 10/1/10(日) 21:31 発言[未読]

【63957】Findについて
質問  きくと  - 10/1/4(月) 0:17 -

引用なし
パスワード
   同じ行を複数の文字列で検索してAND処理をしたいのですがFindとFindNextを使った場合が期待通りに動かないので質問です。
Set objFind = ws.Cells.Find("検索", LookAt:=xlWhole) ワークシート全体から行を取り出す。
Set objFind2 = ws.Cells.Find("検索", LookAt:=xlWhole,SearchOrder:=xlByColumns) 行方向に2つ目で検索
Set objFind = ws.Cells.FindNext(objFind)
とすると
Set objFind = ws.Cells.FindNext(objFind)が前回検索した、
ws.Cells.Find("検索", LookAt:=xlWhole, SearchOrder:=xlByColumns)を参照してしまうので悩んでいます。
これをどうにか最初のws.Cells.Find("検索", LookAt:=xlWhole)を参照するようにできませんか?

【63958】Re:Findについて
発言  かみちゃん  - 10/1/4(月) 5:38 -

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

>これをどうにか最初のws.Cells.Find("検索", LookAt:=xlWhole)を参照するように

ws.Cells.Find("検索", LookAt:=xlWhole, SearchOrder:=xlByRows)
ということでしょうか?

【63959】Re:Findについて
発言  kanabun  - 10/1/4(月) 10:22 -

引用なし
パスワード
   ▼きくと さん:

おじゃまします。
>同じ行を複数の文字列で検索してAND処理をしたいのですが
>FindとFindNextを使った場合が期待通りに動かないので質問です。

たとえば以下のようなシートレイアウトで教えてもらえませんか?

  [A]    [B]    [C]
[1]     検索    
[2]         検索
[3]     検索    
[4]         
[5] 検索        検索
[6]     検索    
[7]         
[8]         検索
[9]     検索    
[10] 検索        
[11]         

たとえば、以下のコードを実行すると
Sub 質問()
 Dim ws As Worksheet
 Dim ● As Range
 Dim ▲ As Range
 Dim ■ As Range
 
 Set ws = ActiveSheet
 ' ワークシート全体から行を取り出す。
 Set ● = ws.Cells.Find("検索", LookAt:=xlWhole, _
          SearchOrder:=xlByRows)  '列方向(→)
   ●.Select
 
 ' 行方向に2つ目で検索
 Set ▲ = ws.Cells.Find("検索", LookAt:=xlWhole, _
          SearchOrder:=xlByColumns) '行方向(↓)
   ▲.Select
 
 '次を検索
 Set ■ = ws.Cells.FindNext(●)  '●の次のセルの検索(↓)
   ■.Select
End Sub

最初にヒットするセル●は [B1]
次にヒットするセル ▲は [A5]
FindNext(●) でヒットするセル■は [B3]
です。

【64002】Re:Findについて
発言  きくと  - 10/1/9(土) 19:50 -

引用なし
パスワード
   ▼kanabun さん:
遅くなってすみません
  [A]    [B]    [C]
[1]     検索1    
[2]         検索3
[3]     検索2    
[4]         
[5] 検索1        検索2
[6]     検索2    
[7]         
[8]         検索3
[9]     検索1    
[10] 検索2        
[11]         


この表から(検索1)(検索2)で検索して、[5]行のセルを選択できるとうれしいです。お願いいたします。

【64005】Re:Findについて
発言  かみちゃん E-MAIL  - 10/1/9(土) 21:19 -

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

>この表から(検索1)(検索2)で検索して、[5]行のセルを選択できる

以下のような感じではいかがでしょうか?

Sub Sample()
 Dim ws As Worksheet
 Dim ● As Range
 Dim ▲ As Range
 Dim firstAddress As String

 Set ws = ActiveSheet
 With ws
  Set ● = .Cells.Find("検索1", After:=.Range("A1"), LookAt:=xlWhole, _
           SearchOrder:=xlByColumns)  '行方向(↓)
  If Not ● Is Nothing Then
   firstAddress = ●.Address
   Do
    Set ▲ = ●.EntireRow.Find("検索2", After:=●, LookAt:=xlWhole, _
             SearchOrder:=xlByRows)  '列方向(→)
    If Not ▲ Is Nothing Then
     ▲.Select
     MsgBox ▲.Row & " 行目に見つかりました。"
     Exit Do
    End If
    Set ● = .Cells.FindNext(●)
    If ● Is Nothing Then Exit Do
   Loop Until ●.Address = firstAddress
  Else
   MsgBox "検索1が見つかりません"
  End If
 End With
 MsgBox "終了しました"
End Sub

【64006】Re:Findについて
発言  kanabun  - 10/1/9(土) 21:27 -

引用なし
パスワード
   ▼きくと さん:

>  [A]    [B]    [C]
>[1]     検索1    
>[2]         検索3
>[3]     検索2    
>[4]         
>[5] 検索1        検索2
>[6]     検索2    
>[7]         
>[8]         検索3
>[9]     検索1    
>[10] 検索2        
>[11]         
>
>
>この表から(検索1)(検索2)で検索して、[5]行のセルを選択できるとうれしいです。

ある行の中に 一つ以上の「検索1」かつ、一つ以上の「検索2」のある「行」
を抽出するということでしょうか?

そうだとすると、Findメソッドでは難しいですよ。

作業列を使って
> 行の中に 一つ以上の「検索1」かつ、一つ以上の「検索2」のある「行」
という条件を数式で書き出し、条件に一致する行を選択することなら
以下のようでできます。

Sub Try1_行単位の検索()
 Dim Rng As Range, r As Range
 Dim xCol As Long
 Dim Find1 As String
 Dim Find2 As String
 
 Find1 = "検索1"         '一つ目の検索値
 Find2 = "検索2"         '二つ目の検索値
 Set Rng = ActiveSheet.UsedRange 'シート全体
 xCol = Rng.Columns.Count
 With Rng.Columns(xCol + 1)
   .FormulaR1C1 = _
    "=IF(AND(COUNTIF(RC1:RC[-1]," & Find1 _
    & ")>0,COUNTIF(RC1:RC[-1]," & Find2 & ")>0),1,"""")"
   On Error Resume Next
   Set r = .SpecialCells(xlFormulas, xlNumbers)
   On Error GoTo 0
   If r Is Nothing Then
     MsgBox "検索に一致する行はありません"
     Exit Sub
   End If
   r.EntireRow.Select
   MsgBox "これらの行がヒットしました"
   
   '後始末
   .ClearContents
 End With
End Sub

【64007】Re:Findについて
発言  kanabun  - 10/1/9(土) 21:33 -

引用なし
パスワード
   すみません。↑のサンプルコード
一行もヒットしなかったときの処理がまずかったです(数式がのこってしまう)

   If r Is Nothing Then
     MsgBox "検索に一致する行はありません"

   Else
     r.EntireRow.Select
     MsgBox "これらの行がヒットしました"
   
   End If
   '後始末
   .ClearContents
 End With

とかに直して検証してもらえませんか?

【64008】Re:Findについて
発言  かみちゃん  - 10/1/9(土) 21:44 -

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

>ある行の中に 一つ以上の「検索1」かつ、一つ以上の「検索2」のある「行」
>を抽出するということでしょうか?
>
>そうだとすると、Findメソッドでは難しいですよ。

何が難しいのでしょうか?
[64005]で提示したとおり、割と普通にできましたけど、何か勘違いしていますでしょうか?

【64010】Re:Findについて
発言  kanabun  - 10/1/9(土) 22:33 -

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

>何が難しいのでしょうか?
>[64005]で提示したとおり、割と普通にできましたけど、何か勘違いしていますでしょうか?

きついことをおっしゃる...

>何が難しいのでしょうか?
コードの管理が...

【64011】Re:Findについて
発言  かみちゃん  - 10/1/9(土) 22:39 -

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

>>何が難しいのでしょうか?
>>[64005]で提示したとおり、割と普通にできましたけど、何か勘違いしていますでしょうか?
>
>きついことをおっしゃる...

えっ?素朴な疑問ですが・・・

>>何が難しいのでしょうか?
>コードの管理が...

どこがでしょうか?
kanabunさん個人としての管理ですか?
意味がよくわかりません。

【64012】Re:Findについて
発言  kanabun  - 10/1/9(土) 22:48 -

引用なし
パスワード
   ▼きくと さん:

わ〜、数式に文字列埋め込み 、間違えました m(__)m

> With Rng.Columns(xCol + 1)
>   .FormulaR1C1 = _
>    "=IF(AND(COUNTIF(RC1:RC[-1]," & Find1 _
>    & ")>0,COUNTIF(RC1:RC[-1]," & Find2 & ")>0),1,"""")"

以下に修正してください
   ↓

   .FormulaR1C1 = _
    "=IF(AND(COUNTIF(RC1:RC[-1],""" & Find1 _
    & """)>0,COUNTIF(RC1:RC[-1],""" & Find2 & """)>0),1,"""")"

ごめんなさい。

【64013】Re:Findについて
発言  kanabun  - 10/1/9(土) 22:51 -

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

>どこがでしょうか?
>kanabunさん個人としての管理ですか?
>意味がよくわかりません。


↓こんなテーブルで試してみてください

    [A]    [B]    [C]    [D]    [E]
[1]    x    x    検索2    x    x
[2]    検索1    x    x    x    x
[3]    検索2    x    検索2    x    x
[4]    検索1    検索1    検索2    x    x
[5]    x    x    x    検索1    x
[6]    x    x    検索2    x    x
[7]    検索1    検索1    検索2    x    x
[8]    x    x    x    x    x
[9]    x    x    検索2    x    x
[10]    x    x    検索2    x    x
[11]    検索1    検索1    x    x    検索2
[12]    x    x    x    x    検索2
[13]    x    x    x    x    x
[14]    検索2    x    検索1    x    x
[15]    検索2    x    x    x    x
[16]    x    x    検索2    x    x
[17]    x    x    x    検索1    x
[18]    x    x    x    検索2    x
[19]    x    x    x    x    x

【64015】Re:Findについて
発言  かみちゃん  - 10/1/9(土) 23:13 -

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

>>どこがでしょうか?
>>kanabunさん個人としての管理ですか?
>>意味がよくわかりません。
>
>
>↓こんなテーブルで試してみてください

試してみました。
とりあえずうまくいかないことは確認できました。
ありがとうございます。

どうも

    Set ▲ = ●.EntireRow.Find("検索2", After:=●, LookAt:=xlWhole, _
             SearchOrder:=xlByRows)  '列方向(→)

のコードがおかしいようです。
勉強してみて、わからなければ、別スレッドで質問させていただきます。

理解不足で、失礼しました。

【64029】Re:Findについて
お礼  きくと  - 10/1/10(日) 20:07 -

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

ありがとうございます。行の選択が出来ました。これを別ブックにコピーするのが難航してますが頑張ります。

【64030】Re:Findについて
発言  kanabun  - 10/1/10(日) 21:31 -

引用なし
パスワード
   ▼きくと さん:

>ありがとうございます。行の選択が出来ました。
>これを別ブックにコピーするのが難航してますが頑張ります。

参考まで。

Sub Try1plus()
 Dim Rng As Range, r As Range
 Dim xCol As Long
 Dim Find1 As String
 Dim Find2 As String
 
 Find1 = "検索1"
 Find2 = "検索2"
 Set Rng = ActiveSheet.UsedRange 'シート全体
 xCol = Rng.Columns.Count
 With Rng.Columns(xCol + 1)
   .FormulaR1C1 = _
    "=IF(AND(COUNTIF(RC1:RC[-1],""" & Find1 _
    & """)>0,COUNTIF(RC1:RC[-1],""" & Find2 & """)>0),1,"""")"
   On Error Resume Next
   Set r = .SpecialCells(xlFormulas, xlNumbers)
   On Error GoTo 0
   If r Is Nothing Then
     MsgBox "検索に一致する行はありません"
   Else
     r.EntireRow.Select       '【該当行の選択】
     If MsgBox("これらの行がヒットしました" _
          & "別ファイルに出力しますか?" _
          , vbOKCancel) _
      = vbOK Then
     '-----------------------------------------------
       Selection.Copy
       With Workbooks.Add(6).Worksheets(1)
         .Cells(1).PasteSpecial
       End With
     End If
     '-----------------------------------------------
   End If
   
   '後始末
   .ClearContents
 End With
End Sub

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