2016-12-18 12 views
1

これは私のデータのサンプルで、nameはセルA1に入っています。列Cはデータの一部ではなく、必要なものを説明するためだけにあります。文字列内の特定の番号を見つけるか?

name cod  should be detected? 
aa    no 
aa  14;15 no 
aa  1;13;7 yes 
bb  8;9;1 yes 
bb  1;17 yes 
bb  11;21 no 
cz  7;8  no 
cz  7;21 no 
cz  8;1;20 yes 
db  1  yes 
db  13;1 yes 

私はコラムcod数1が表示されますに検出するマクロを記述しようとしています。たとえば、私は10,13,21が見つからないようにしますが、1を探しています。この列の数字は1から21までです。

すべてcodの値は文字列ですが、1の文字列内に他の数字が混在していても、その場所を探したいと思います。この列の数値は常に;で区切られ、間に空白はありません。

次のコードが生成されます偽陽性

Dim N As Range 
Dim msg As String 

Sub cod1() 

msg = "" 

For Each N In Range("A2", Range("A2").End(xlDown)) 
    If InStr(1, N.Offset(, 1), 1, vbTextCompare) > 0 Then 
       msg = msg & "Code 1 was not supposed to be in Cod column." & vbLf 
      Exit For 
    End If 
Next N 

    If Len(msg) > 1 Then 
     MsgBox msg 
    Else: MsgBox "There are no code 1 values in Cod column." 
    End If 

End Sub 

を参照してください。結果:

name cod  should be detected? problem 
aa    no 
aa  14;15 no     false positive 
aa  1;13;7 yes 
bb  8;9;1 yes 
bb  1;17 yes 
bb  11;21 no     false positive 
cz  7;8  no 
cz  7;21 no     false positive 
cz  8;1;20 yes 
db  1  yes 
db  13;1 yes 

次のコードは、ネガ偽生成されます。

Dim N As Range 
Dim msg As String 

Sub cod2() 

msg = "" 

For Each N In Range("A2", Range("A2").End(xlDown)) 
    If InStr(1, N.Offset(, 1), 1, vbTextCompare) > 0 And _ 
     InStr(1, N.Offset(, 1), 10, vbTextCompare) = 0 And _ 
     InStr(1, N.Offset(, 1), 11, vbTextCompare) = 0 And _ 
     InStr(1, N.Offset(, 1), 12, vbTextCompare) = 0 And _ 
     InStr(1, N.Offset(, 1), 13, vbTextCompare) = 0 And _ 
     InStr(1, N.Offset(, 1), 14, vbTextCompare) = 0 And _ 
     InStr(1, N.Offset(, 1), 15, vbTextCompare) = 0 And _ 
     InStr(1, N.Offset(, 1), 16, vbTextCompare) = 0 And _ 
     InStr(1, N.Offset(, 1), 17, vbTextCompare) = 0 And _ 
     InStr(1, N.Offset(, 1), 18, vbTextCompare) = 0 And _ 
     InStr(1, N.Offset(, 1), 19, vbTextCompare) = 0 And _ 
     InStr(1, N.Offset(, 1), 21, vbTextCompare) = 0 Then 
      msg = msg & "Code 1 was not supposed to be in Cod column." & vbLf 
     Exit For 
    End If 
Next N 

    If Len(msg) > 1 Then 
     MsgBox msg 
    Else: MsgBox "There are no code 1 values in Cod column." 
    End If 

End Sub 

の結果を参照してください:だから

name cod  should be detected? problem 
aa    no 
aa  14;15 no 
aa  1;13;7 yes     false negative 
bb  8;9;1 yes 
bb  1;17 yes     false negative 
bb  11;21 no 
cz  7;8;10 no 
cz  7;21 no 
cz  8;1;20 yes     false negative 
db  1  yes 
db  13;1 yes     false negative 

を、どのように1は、メッセージボックスを作ることができます*数1が文字列内に検出された場合にのみ表示されますか?

*コード1はコードの列には含まれていませんでした。 Excel 2007の以降のバージョンで動作するソリューションを探してい


。いずれかを使用して、あなたは、セル内の任意の値の存在を検出し、一般的なUDF(ユーザー定義関数)を持つことができ、また

Dim N As Range 
Dim msg As String 

Sub cod1() 

    Dim expression As String 
    msg = "" 

    For Each N In Range("A2", Range("A2").End(xlDown)) 
     expression = ";" & N.Offset(, 1) & ";" 
     If expression Like "*;1;*" Then 
      msg = msg & "Code 1 was not supposed to be in Cod column." & vbLf 
     End If 
    Next N 

    If Len(msg) > 1 Then 
     MsgBox msg 
    Else 
     MsgBox "There are no code 1 values in Cod column." 
    End If 

End Sub 

答えて

2

あなたは文字を見つけるためにLike演算子を使用することができますセパレーター:

Public Function hasItem(ByVal r As Range, item As Variant, sep As String) As Boolean 
    ar = Split(r.Text, sep) 
    For Each x In ar 
     If Trim(CStr(x)) = Trim(CStr(item)) Then 
      hasItem = True 
      Exit Function 
     End If 
    Next 
End Function 

は、コードモジュールModule1上記UDFを入れ、そしてC1、すなわち列C、あなたの細胞でこのようにそれを使用します。

=IF(hasItem(B1, 1, ";"), "yes", "no") 

Cのすべてのセルにコピーして貼り付けることができます。 また、任意のVBAコードで便利にこの機能を使用して、必要なメッセージを表示することができます。

+0

3つの回答(ThunderFrame、A.S.H、EEM)は、それぞれ異なるアプローチで、サンプルと実際のデータ(すべて+1)でうまく機能しました。そして、コードの構造が私がすでに使っていたものと似ていたので、私はこれを受け入れています。 –

1

1

この解決策ではSplit関数を使用して列Bに値の配列を生成し、各配列項目を比較します。

Sub Test() 
Dim rDta As Range, rRow As Range 
Dim aRow As Variant, vItm As Variant 
Dim sMsg As String, lRow As Long 

    With ThisWorkbook.Sheets("DATA.3").Cells(1).CurrentRegion 'change as required 
     Set rDta = .Offset(1).Resize(-1 + .Rows.Count) 
    End With 

    lRow = 1 
    For Each rRow In rDta.Rows 
     lRow = 1 + lRow 
     aRow = Split(rRow.Cells(2).Value2, ";") 
     For Each vItm In aRow 
      If vItm = 1 Then 
       If sMsg = vbNullString Then sMsg = "Code 1 was not supposed to be in Cod column of rows:" 
        sMsg = sMsg & vbLf & vbTab & lRow 
       rRow.Cells(1, 3).Value = "Code 1 was not supposed to be in Cod column." 'Remove if required 
    End If: Next: Next 

    If sMsg = vbNullString Then sMsg = "There are no code 1 values in Cod column." 
    MsgBox sMsg 

End Sub 
関連する問題