Question

我从@ user3598756获得了此代码的帮助。

我正在尝试将值从我的从属工作簿复制到我的主工作簿。

我的奴隶工作簿可以不时更改名称，但总是会在标题中包含“depot memo”或“Depot Memo”。

Food Depot Memo
DRINKS DEPOT MEMO
Bakery depot memo 123

到目前为止，我有以下代码，如果文件名包含带有大写字母的“Depot Memo”，则可以使用。

但是，如果'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

在您的代码中实现类似这样的内容，以大写您的从属工作簿名称，然后检查它是否包含＆＃34; DEPOT MEMO＆＃34;。

    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

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

2 个答案: