Excel (VBA)

Excel VBAに関するフォーラムです。
  • 解決済みのトピックにはコメントできません。
このトピックは解決済みです。
質問

 
(Windows 8.1 : Excel 2013)
検索について
投稿日時: 20/11/16 19:00:42
投稿者: アール

検索する値を部分一致でシートのセル(A列)全て検索したいです。
検索後、ヒットしたセルの位置とそのB列、C列を取得したいのですが、
 
Find Find Nextを使用した場合、FindNextの引数でエラーになってしまいます。
InStrを使用して上から順に検索した方が良いのでしょうか。
もしくはまた別のやり方がございますか?
ご教示ください。
 

回答
投稿日時: 20/11/16 19:05:13
投稿者: WinArrow
投稿者のウェブサイトに移動

まず、作成したコードを掲示しましょう。
 
その方が、早い解決につながります。

回答
投稿日時: 20/11/17 02:56:31
投稿者: mougtun13

部分一致したい文字列を「文字列」とした場合
B列を調べるなら
「文字列」の前後に * を付けて
=VLOOKUP("*文字列*",A:B,2,FALSE)
とし、
C列を調べるなら
=VLOOKUP("*文字列*",A:C,3,FALSE)
とすれば調べられます。
 
前方一致だけなら文字列の前にだけ * を付け
後方一致なら文字列の後にだけ * を付ければ検索できます。
 
これらはA列の上から検索して最初に見つかったものを返しますが
2番目とかは、INDEX や MATCH を使えば可能です。

投稿日時: 20/11/17 09:05:52
投稿者: アール

コードを記載いたします。
strTypeはRange型
Array1はVariantです。
★を付けた箇所でエラーとなります。
 
 
 With ws1
         EndRow = .Cells(Rows.Count, 1).End(xlUp).row
          
' For i = 0 To EndRow
            
           Set Findcell = .Columns("T").Find(strType, LookAt:=xlPart)
             
            'Findcellがある場合
            If Not Findcell Is Nothing Then
             FirstAddress = Findcell.Address
             '配列にArray1格納
             ReDim Array1(0)
             'FindcellのB列取得
             Array1(0) = .Cells(Findcell.row, 2)
              
            'Findcellがない場合
             Exit Function
            End If
             
            '次のセルを検索
            Do
                '一致するまで繰り返し
 ★ Set Findcell = .Columns("T").FindNext(After:=strType)
                   
                  ReDim Preserve Array1(UBound(Array1) + 1)
                   
                'FindcellのB列取得
                  Array1(i) = .Cells(Findcell.row, 2)
             
            Loop Until Findcell.Address = FirstAddress
             
' Next
             
' '余分の1つを削除
' ReDim Preserve Array1(UBound(Array1) - 1)
             
       End With

回答
投稿日時: 20/11/17 10:43:14
投稿者: WinArrow
投稿者のウェブサイトに移動

基本的なところ
@
> Set Findcell = .Columns("T").Find(strType, LookAt:=xlPart)
StrTypeはRangeオブジェクトですから、「値」を与える必要があります。

 Set Findcell = .Columns("T").Find(strType.Value, LookAt:=xlPart)
 
A
>Set Findcell = .Columns("T").FindNext(After:=strType)
FindNextの引数には、前回ヒットしたセル(オブジェクト)を指定します。

Set Findcell = .Columns("T").FindNext(After:=FindCell)
 
※1
1回目の検索でヒットしなかったときは、、即、処理を抜けた方がコードの可読性が上がります。
※2
配列に格納するところは、Do〜Loopの中に入れることです。
余分な配列の後始末は不要です。
 
※3
インデントをきちんとつけましょう。
 
以下、サンプルコードです。
 
 
Function 検索(ByVal strType As Range)
Dim EndRow As Long
Dim ws1 As Worksheet
Dim FindCell As Range, FirstAddress As String
Dim Array1, i As Long
 
    Set ws1 = ActiveSheet
    With ws1
' EndRow = .Cells(Rows.Count, 1).End(xlUp).Row
            
 ' For i = 0 To EndRow
        i = 0
        ReDim Array1(i)
              
        Set FindCell = .Columns("T").Find(strType.Value, LookAt:=xlPart)
               
        If FindCell Is Nothing Then Goto Exit1
        'Findcellがある場合
        FirstAddress = FindCell.Address
        Do
            '配列にArray1格納
            'FindcellのB列取得
            ReDim Preserve Array1(i)
            Array1(i) = .Cells(FindCell.Row, "B").Value
                  
             '次のセルを検索
            Set FindCell = .Columns("T").FindNext(After:=FindCell)
                 '一致するまで繰り返し
             i = i + 1
        Loop Until FindCell.Address = FirstAddress
               
 ' Next
    End With
Exit1:
    検索 = Array1
End Function

投稿日時: 20/11/17 12:50:20
投稿者: アール

ありがとうございます。解決いたしました。