VBAのセル内Valueのあいまい検索

Question

ExcelVBAについて、セル内に打ち込まれた文字列の一部が同シート内のリストにある文字列の一部と一致すればピックアップするというマクロを組みたいのですが、うまくコードが思い浮かばなかったので質問させていただきます。

例えば以下のマクロの If ary(k, 2) = Cells(2, 8) Then の箇所で、ary(k,2)に"1880_1"、Cells(2,8)の箇所に"1880_2"と入力されていた場合、_前の1880が一致しているためそれをピックアップし別のセルに転記するという動作をさせたいです。

いろいろ調べたり考えたりしてみたもののいいコードが思いつかず。。
どうかご回答お願いいたします。

Set outRng = Range(Cells(2, 1), Cells(Rows.Count, 1).End(xlUp))
     ary = outRng
     For k = LBound(ary) To UBound(ary)
         If ary(k, 2) = Cells(2, 8) Then
            Rng.Cells(k, 2).EntireRow.Copy Destination:= _
               Worksheets("result").Cells(ii, 1)
         End If
      Next

Comments

[tatsu99]

不明点
１．"AA1800" と "BB1800"のように途中が同じ場合は、転記対象外ですか。
２．Cells(2,8)が"1800_2"で、"1800_1"のセルと"1899"のセルがあった場合は、どちらも転記対象になりますか。

[toradora]

説明が不明瞭で申し訳ありません。
対象のセルの値としては、"数字数桁_数字数桁"(ex.1885_63, 328350_22
等) という構成になっていて、_前が一致していればピックアップという形をとりたいです。
なので2.については、Cells(2,8)が"1800_2"であった場合、"1800_1"がピックアップ対象となり、"1899"は対象外という形になります。

Answer 1

MyCompは_の直前までの文字列が一致した場合、trueを返し、そうでなければfalseを返します。
If ary(k, 2) = Cells(2, 8) Thenを
If Mycomp(ary(k, 2),Cells(2, 8)) = true then
のように変えて使ってください。

'文字列比較(_の直前までの文字列が一致した場合、trueを返す)
Public Function MyComp(ByVal p1 As String, ByVal p2 As String) As Boolean
    MyComp = False
    Dim r1 As Variant
    Dim r2 As Variant
    r1 = InStr(p1, "_")
    If r1 < 2 Then Exit Function
    r2 = InStr(p2, "_")
    If r2 < 2 Then Exit Function
    If r1 <> r2 Then Exit Function
    If Left(p1, r1 - 1) <> Left(p2, r2 - 1) Then Exit Function
    MyComp = True
End Function

Comments

[toradora]

回答ありがとうございます。
途中のIf r1 < 2 Then Exit Functionや、If r2 < 2 Then Exit Functionの箇所はなぜr1(r2) < 2であった場合exitをする処理にしているのでしょうか？

[tatsu99]

r1 < 2が成立するのは、
p1の文字列中に_が存在しない場合（r1=0）
p1の文字列中の先頭が_で始まっている場合(r1=1)
のケースです。この場合は、比較しても意味がないのでfalseを返します。
Exit Functionを実行すると、最初にMyComp = Falseを実行しているので、falseが呼び出し側に返ります。

[toradora]

ありがとうございます。
そのあとのIf r1 <> r2 Then Exit FunctionやIf Left(p1, r1 - 1) <> Left(p2, r2 - 1) Then Exit Functionにひっかからなかった場合のみMyComp=Trueとなり、Trueが呼び出し側に返るということですね。

[tatsu99]

はい。そうです。

Answer 2

以下は、二つの文字列を先頭から順に比較して一致しているところまでを返すFunctionの例。

Function similar(a As String, b As String) As String
    Dim i, x
    x = IIf(Len(a) < Len(b), Len(a), Len(b))
    For i = 1 To x
        If Left(a, i) = Left(b, i) Then similar = Left(a, i)
    Next
End Function

Answer 3

例えば以下のマクロの If ary(k, 2) = Cells(2, 8) Then の箇所で、ary(k,2)に"1880_1"、Cells(2,8)の箇所に"1880_2"と入力されていた場合、_前の1880が一致しているためそれをピックアップし別のセルに転記するという動作をさせたいです。

これが、先頭一文字でも一致していたらということなら、

 If Left(ary(k, 2), 1) = Left(Cells(2, 8),1) Then 

4文字目まで一致していたら、という意味なら、

 If Left(ary(k, 2), ４) = Left(Cells(2, 8), 4) Then 

_の前まで一致していたらということなら、

 If Split(ary(k, 2) & "_", "_")(0) = Split(Cells(2, 8) & "_", "_")(0) Then 

上記のどれでもないなら、もう少し明確に仕様を提示してください。

Comments

[toradora]

_の前まで一致していたらピックアップするという動作をさせたいということです。
説明不足で申し訳ありません。

[hatena19]

それなら、私の回答の一番最後の式でいいですね。