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
検索マクロ全コード