參考工作簿其中包含文件名中的特定文本？

Question

我使用此代碼獲得了@ user3598756的幫助。

我想從我的奴隸工作簿複製到我的主工作簿的值。

我的奴隸工作簿可以隨時更改名稱，但在標題中始終包含「倉庫備忘錄」或「倉庫備忘錄」。

Food Depot Memo 
DRINKS DEPOT MEMO 
Bakery depot memo 123 

到目前爲止，我有下面的代碼工作，如果文件名中包含「得寶備忘錄」用大寫字母。

但是，如果「depot memo」爲小寫，此代碼不起作用。 請有人告訴我我要去哪裏？

代碼：

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備忘錄」。

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