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

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

我想出了答案，它相對簡單。

所有需要添加到模塊頂部的是：

 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

Answer 2

在您的代碼中實現類似的內容以大寫您的從屬工作簿名稱，然后檢查它是否包含“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