検索マクロ全コード

Public Sub 検索(ByVal Namae As String, ByVal MeNamae As Object, ByVal Retsu As Integer, ByVal meSheet As Object, ByVal vSheet As Object, Rtn As Boolean)

    Dim Nagasa As Integer
    Dim i As Long
    Dim MaxRows As Long
    Dim Touseki As Worksheet
    Dim KensakuChar As String
    Dim ListNamae As String
    Dim ListChar As String
    Dim KBanme As Integer
    Dim LBanme As Integer
    Dim KensakuRow() As Long
    Dim g As Long
    Dim S2 As Object
    Dim ListNagasa As Long
    Dim NamaeNagasa As Long
    Dim Tango As String
    Dim r As Integer
    Dim ChrSu As Integer
    Dim Mojiretsu As String
    Dim Renzoku As Boolean
    Dim P As Integer
    Dim Charsu As Integer
    Dim Ren As Integer
    Dim ListNamaeX As String
    
    
    
    
If Rtn = True Then

    Set Touseki = meSheet
    Set S2 = vSheet
    MaxRows = Touseki.UsedRange.Rows.Count
    g = 1
    Nagasa = Len(Namae)
    MeNamae.ListBox1.Clear
    
    For i = 1 To MaxRows
        ListNamae = Touseki.Cells(i, Retsu)
        ListNamaeX = ListNamae
        ListNamae = StrConv(ListNamae, vbWide)
        ListMojisu = Len(ListNamae)
        ListNamae = Replace(ListNamae, " ", "")
        ListNamae = Replace(ListNamae, " ", "")
        Namae = Replace(Namae, " ", "")
        Namae = Replace(Namae, " ", "")
        KBanme = 0
        LBanme = 0
        Do
            Do While Nagasa >= KBanme
                KBanme = KBanme + 1
                KensakuChar = Mid(Namae, KBanme, 1)
                If KensakuChar <> " " Then
                    Exit Do
                End If
            Loop
            Do While Nagasa >= LBanme
                LBanme = LBanme + 1
                ListChar = Mid(ListNamae, LBanme, 1)
                If ListChar <> "" Then
                    Exit Do
                End If
            Loop
            
            If KensakuChar = ListChar Then
                If Nagasa = KBanme Then
                    If ListMojisu = Nagasa Then
                        'If ListMojisu = Nagasa1 Then
                    With MeNamae
                        .ListBox1.AddItem (ListNamaeX)
                        S2.Cells(g, 2) = i
                        g = g + 1
                    End With
                    End If
                End If
            Else
                Exit Do
            End If
        Loop Until Nagasa <= KBanme
    Next
    
    
Else
           
    Set Touseki = meSheet
    Set S2 = vSheet
        MaxRows = Touseki.UsedRange.Rows.Count
    
        g = 1
        MeNamae.ListBox1.Clear
        Erase KensakuRow
        ReDim KensakuRow(MaxRows)
        For i = 1 To MaxRows
            ListNamae = Touseki.Cells(i, Retsu)
            ListNamaeX = ListNamae
            ListNamae = StrConv(ListNamae, vbWide)
            ListNamae = Replace(ListNamae, " ", "")
            ListNamae = Replace(ListNamae, " ", "")
            Namae = Replace(Namae, " ", "")
            Namae = Replace(Namae, " ", "")
            ListNagasa = Len(ListNamae)
            NamaeNagasa = Len(Namae)
            KBanme = 0
            LBanme = 0
            r = 1
            Charsu = 0
            Renzoku = False
            Ren = 0
        
            
            Do While NamaeNagasa >= KBanme
                KBanme = KBanme + 1
                KensakuChar = Mid(Namae, KBanme, 1)
                If KensakuChar <> " " Or KensakuChar <> " " Then
                    Exit Do
                End If
            Loop
            Do While NamaeNagasa >= LBanme
                LBanme = LBanme + 1
                ListChar = Mid(ListNamae, LBanme, 1)
                If ListChar <> " " Or ListChar <> " " Then
                    Exit Do
                End If
            Loop
            For P = 1 To ListNagasa
                    r = r + 1
                If KensakuChar = ListChar Then
                    Renzoku = True
                    Charsu = Charsu + 1
                    
                    If NamaeNagasa = Charsu Then
                        With MeNamae
                            .ListBox1.AddItem (ListNamaeX)
                            S2.Cells(g, 2) = i
                            g = g + 1
                        End With
                        KBanme = 0
                        Exit For
                    End If
                     
                     If NamaeNagasa >= Charsu Then
                     'Do While NamaeNagasa >= Charsu
                        KBanme = KBanme + 1
                        KensakuChar = Mid(Namae, KBanme, 1)
                        'If KensakuChar <> " " Or KensakuChar = " " Then
                        '    Exit Do
                        'End If
                     'Loop
                     End If
                     If ListNagasa >= LBanme Then
                     'Do While ListNagasa >= LBanme
                        LBanme = LBanme + 1
                        ListChar = Mid(ListNamae, r, 1)
                        'If ListChar <> " " Or ListChar = " " Then
                        '    Exit Do
                         'End If
                      'Loop
                      End If
                    Else
                        If Renzoku = True Then
                            Exit For
                        End If
                        
                        LBanme = LBanme + 1
                        ListChar = Mid(ListNamae, LBanme, 1)
                     
                     
            End If
            
        Next
            
    Next
    
End If

End Sub