ファイル名に特定のテキストが含まれている参照ブック？

Question

このコードで@ user3598756の助けがありました。

スレーブブックからマスターブックに値をコピーしようとしています。

私のスレーブブックは、名前を変更することがありますが、タイトルには常に「デポメモ」または「デポメモ」が含まれます。

Food Depot Memo 
DRINKS DEPOT MEMO 
Bakery depot memo 123 

これまでのところ私は、ファイル名は大文字で「デポメモ」が含まれている場合に動作し、以下のコードを持っています。

ただし、「デポメモ」が小文字の場合、このコードは機能しません。 誰かが間違っている場所を私に見せてもらえますか？

コード：

Option Explicit 

Private Sub Worksheet_Change(ByVal Target As Range) 
    Dim oCell As Range, targetCell As Range 
    Dim ws2 As Worksheet 

    If Not Intersect(Target, Range("I:I")) Is Nothing Then ' <-- run this code only if a value in column I has changed 
     If Not GetWb("Depot Memo", ws2) Then Exit Sub 

     With ws2 
      For Each targetCell In Target 
       Set oCell = .Range("J1", .Cells(.Rows.Count, "J").End(xlUp)).Find(what:=targetCell.Value, LookIn:=xlValues, lookat:=xlWhole) 
       If Not oCell Is Nothing Then 
        Application.EnableEvents = False 
        targetCell.Offset(0, 1).Value = oCell.Offset(0, -3) 
        targetCell.Offset(0, 2).Value = oCell.Offset(0, 8) 

        Application.EnableEvents = True 
       End If 
      Next 
     End With 
    End If 
End Sub 

Function GetWb(wbNameLike As String, ws As Worksheet) As Boolean 
    Dim wb As Workbook 
    For Each wb In Workbooks 
     If wb.Name Like "*" & wbNameLike & "*" Then '<-- check if workbook name contains "Depot Memo" 
      Set ws = wb.Worksheets(1) 
      Exit For 
     End If 
    Next 
    GetWb = Not ws Is Nothing 
End Function 

Answer 1

あなたのスレーブワークブック名​​を大文字にあなたのコードの中にこのような何かを実装し、それが「DEPOTのMEMO」が含まれているかどうかをチェック。あなたのコードに実装

Sub Example() 
     Dim IncomingWBName As String 
     IncomingWBName = "Drinks DEPOT Memo" 'Set incoming name 
     IncomingWBName = UCase(IncomingWBName) 'Set all to uppercase 
     If InStr(IncomingWBName, "DEPOT MEMO") > 0 Then 'In String? 
      MsgBox "Contains DEPOT MEMO" 
      'Do something 
     Else 
      MsgBox "Doesn't contain DEPOT MEMO" 
      'Do Something else 
     End If 
    End Sub 

--- ---

Option Explicit 

Private Sub Worksheet_Change(ByVal Target As Range) 
    Dim oCell As Range, targetCell As Range 
    Dim ws2 As Worksheet 

    If Not Intersect(Target, Range("I:I")) Is Nothing Then ' <-- run this code only if a value in column I has changed 
     If Not GetWb(ws2) Then Exit Sub 

     With ws2 
      For Each targetCell In Target 
       Set oCell = .Range("J1", .Cells(.Rows.Count, "J").End(xlUp)).Find(what:=targetCell.Value, LookIn:=xlValues, lookat:=xlWhole) 
       If Not oCell Is Nothing Then 
        Application.EnableEvents = False 
        targetCell.Offset(0, 1).Value = oCell.Offset(0, -3) 
        targetCell.Offset(0, 2).Value = oCell.Offset(0, 8) 

        Application.EnableEvents = True 
       End If 
      Next 
     End With 
    End If 
End Sub 

Function GetWb(ws As Worksheet) As Boolean 
    Dim wb As Workbook 
    For Each wb In Workbooks 
     If InStr(UCase(wb.Name), "DEPOT MEMO") > 0 Then '<-- check if workbook name contains "DEPOT MEMO" 
      Set ws = wb.Worksheets(1) 
      Exit For 
     End If 
    Next 
    GetWb = Not ws Is Nothing 
End Function 

Answer 2

私は答えを考え出し、及びその比較的簡単。

モジュールの先頭に追加する必要があるすべては、次のとおりです。

Option Compare Text 

これは本質的に大文字と小文字の区別

完全なコード

Option Explicit 
Option Compare Text 

Private Sub Worksheet_Change(ByVal Target As Range) 
    Dim oCell As Range, targetCell As Range 
    Dim ws2 As Worksheet 

    If Not Intersect(Target, Range("I:I")) Is Nothing Then ' <-- run this code only if a value in column I has changed 
     If Not GetWb("Depot Memo", ws2) Then Exit Sub 

     With ws2 
      For Each targetCell In Target 
       Set oCell = .Range("J1", .Cells(.Rows.Count, "J").End(xlUp)).Find(what:=targetCell.Value, LookIn:=xlValues, lookat:=xlWhole) 
       If Not oCell Is Nothing Then 
        Application.EnableEvents = False 
        targetCell.Offset(0, 1).Value = oCell.Offset(0, -3) 
        targetCell.Offset(0, 2).Value = oCell.Offset(0, 8) 

        Application.EnableEvents = True 
       End If 
      Next 
     End With 
    End If 
End Sub 

Function GetWb(wbNameLike As String, ws As Worksheet) As Boolean 
    Dim wb As Workbook 
    For Each wb In Workbooks 
     If wb.Name Like "*" & wbNameLike & "*" Then '<-- check if workbook name contains "Depot Memo" 
      Set ws = wb.Worksheets(1) 
      Exit For 
     End If 
    Next 
    GetWb = Not ws Is Nothing 
End Function