如何解决excel vba中的Find（what：=）字符限制 [英] How can I work around the Find(what:=) character limitation in excel vba

问题描述

我刚刚在我的部门发布了一个Excel加载项，以前我已经在最近的2+个月里检查了大约30个验证错误。我在所有情况下处理错误陷阱（如现在看来），但是当我收到两个重要错误的自动电子邮件（内置于错误处理中的功能）时，我收到了一个可怕的唤醒电话。第一个是下面的，第二个我将单独发布。

第一个bug与 .Find what：= 字符限制

抛出此错误的子句如下：

 '将Upcharge列转换为所有大写作为安全协议，
'检查选项名称中的冒号，并从选项名称列和
'upcharge列中删除它们，如果有任何增加对应于特定产品的该选项名称。 
 Private Sub colOpNaCheck（）
错误GoTo ErrHandler 
 Application.StatusBar =（11/16）检查冒号的选项名称
 
 Dim rng As Range， aCell As Range，uRng1 As Range，uRng2 As Range，uCell As Range，tempC As Range 
 Dim endRange As Long 
 Dim opName As String，opName2 As String 
 Dim xid As String 
 
 endRange = ActiveSheet.Range（A& Rows.count）.End（xlUp）.Row 
 
设置rng = ActiveSheet.Range（W1：W& endRange ）
 
设置aCell = rng.Find（What：=：，LookIn：= xlValues，_ 
 LookAt：= xlPart，SearchOrder：= xlByRows，SearchDirection = = xlNext，_ 
 MatchCase：= False，SearchFormat：= False）
 
如果不是aCell是没有，然后
'将冒号添加到字符串的开头和结尾，以确保我们只找到并替换正确的
'部分在upcharge列
 opName =：& aCell.Value& ：
'更正列中的值
 aCell = Replace（ActiveSheet.Range（W& aCell.Row）.Value，：，）
'将更正的值（sans-colon）设置为opName2并将冒号添加到开头，
'字符串结束
 opName2 =：& aCell.Value& ：
'注意当前行的XID，所以我们可以确保我们查找正确的upcharge 
 xid = ActiveSheet.Range（A& aCell.Row）.Value 
 '我们有选项名称和与它相关联的xid 
'现在我们必须在upcharges列中查找是否找到opName 
'然后我们做一个if语句，只执行if列A XID值匹配
'我们现在的当前xid值
设置uRng1 = ActiveSheet.Range（CT1：CT& endRange）
设置uRng2 = ActiveSheet.Range CU1：CU& endRange）
 
'转换uRng1& uRng2到所有大写字母，以确保在使用Find 
 ActiveSheet.Range（uRng1，uRng2）时检测到它们。选择
对于每个tempC在选择中
'如果单元格不包含错误AND不是缺少一个值/是空的AND单元格还没有全部大写
'AND Row不是1.所有这些检查帮助我们保存处理时间
如果不是IsError（tempC）而不是IsMissing （tempC）和tempC.Value<> UCase（tempC.Value）和tempC.Row 1然后
 tempC.Value = UCase（tempC）
结束If 
下一个tempC 
 
'将uCell设置为opName的第一个实例
设置uCell = uRng1.Find（什么：= UCase（opName），LookIn：= xlValues，_ 
 LookAt：= xlPart，SearchOrder：= xlByRows，SearchDirection：= xlNext，_ 
 MatchCase：= False，SearchFormat：= False）
'如果有一个opName的实例，并且uCell的值检查xid是否匹配
'，以确保我们正在更改正确的upcharge 
 Do 
'检查增加
设置uCell = uRng1.Find（什么：= UCase（opName），LookIn：= xlValues，_ 
 LookAt：= xlPart，SearchOrder：= xlByRows，SearchDirection：= xlNext，_ 
 MatchCase：= False，SearchFormat：= False）
如果不是uCell不是，然后
尽管ActiveSheet.Range（A& uCell.Row）.Value = xid 
设置uCell = uRng1.Find（什么：= UCase（opName），LookIn：= xlValues，_ 
 LookAt：= xlPart，SearchOrder：= xlByRows，SearchDirection：= xlNext，_ 
 MatchCase：= False，SearchFormat ：= False）
'更正列CT 
中的值如果不是uCell不是则
如果ActiveSheet.Range（A& uCell.Row）.Value = xid然后
 uCell = Replace（UCase（ActiveSheet.Range（CT& uCell.Row）.Value），UCase（opName），UCase（opName2））
否则
退出
结束如果
否则
退出执行
结束如果
循环
结束如果
 
'现在我们来看看upcharge_criteria_2列
设置uCell = uRng2.Find（什么：= UCase（opName），LookIn：= xlValues，_ 
 LookAt：= xlPart，SearchOrder：= xlByRows，SearchDirection：= xlNext， _ 
 MatchCase：= False，SearchFormat：= False）
如果不是uCell是没有，然后
 Do While ActiveSheet.Range（A& uCell.Row）.Value = xid 
设置uCell = uRng2.Find（什么：= UCase（opName），LookIn：= xlValues，_ 
 LookAt：= xlPart，SearchOrd er：= xlByRows，SearchDirection：= xlNext，_ 
 MatchCase：= False，SearchFormat：= False）
'更正列CU 
中的值如果不是uCell，则为
如果ActiveSheet.Range（A& uCell.Row）.Value = xid然后
 uCell = Replace（UCase（ActiveSheet.Range（CU& uCell.Row）.Value），UCase（opName），UCase（opName2））
否则
退出
结束如果
 Else 
退出Do 
结束如果
循环
结束如果
'退出Do语句因为我们已经修复了这个特定选项名称的所有充值
退出Do 
循环
 
 Do 
'检查选项
设置aCell = rng。 Find（What：=：，LookIn：= xlValues，LookAt：= xlPart，SearchOrder = = xlByRows，SearchDirection：= xlNext，_ 
 MatchCase：= False，SearchFormat：= False）
如果不aCell Is Nothing然后
'将冒号添加到字符串的开头和结尾，以确保我们只找到
'替换righ t部分在upcharge列中
 opName =：& aCell.Value& ：
'更正列W（Option_Name）中的值
 aCell = Replace（ActiveSheet.Range（W& aCell.Row）.Value，：，）
'将修正的值（sans-colon）设置为opName2并将冒号添加到
'字符串的开头和结尾
 opName2 =：& aCell.Value& ：
'注意当前行的XID，所以我们可以确保我们查找正确的upcharge 
 xid = ActiveSheet.Range（A& aCell.Row）.Value 
做$ $ $ $ 
设置uCell = uRng1.Find（什么：= UCase（opName），LookIn：= xlValues，_ 
 LookAt：= xlPart，SearchOrder：= xlByRows，SearchDirection： = xlNext，_ 
 MatchCase：= False，SearchFormat：= False）
如果不是uCell是没有，然后
尽管ActiveSheet.Range（A& uCell.Row）.Value = xid 
设置uCell = uRng1.Find（什么：= UCase（opName），LookIn：= xlValues，_ 
 LookAt：= xlPart，SearchOrder = = xlByRows，SearchDirection：= xlNext，_ 
 MatchCase：= False，SearchFormat：= False）
'更正值列CT 
如果不是uCell不是然后
如果ActiveSheet.Range（A& uCell.Row）.Value = xid然后
 uCell = Replace（UCase（ActiveSheet.Range（CT& uCell.Row）.Value），UCase（opName），UCase（opName2））
否则
退出
结束如果
否则
退出执行
结束如果
循环
结束如果
 
'现在我们来看看upcharge_criteria_2列
设置uCell = uRng2.Find（什么：= UCase（opName），LookIn：= xlValues，_ 
 LookAt：= xlPart，SearchOrder：= xlByRows，SearchDirection：= xlNext， _ 
 MatchCase：= False，SearchFormat：= False）
如果不是uCell是没有，然后
 Do While ActiveSheet.Range（A& uCell.Row）.Value = xid 
设置uCell = uRng2.Find（什么：= UCase（opName），LookIn：= xlValues，_ 
 LookAt：= xlPart，SearchOrder：= xlByRows，SearchDirection：= xlNext，_ 
 MatchCase：= False， SearchFormat：= False）
'更正列CU 
中的值如果不是uCell是Nothing然后
如果ActiveSheet.Range（A& uCell.Row）.Value = xid然后
 uCell = Replace（UCase（ActiveSheet.Range（CU& uCell.Row）.Value），UCase（opName），UCase（opName2））
否则
退出
结束如果
 Else 
退出Do 
结束如果
循环
结束如果
'退出Do语句因为我们已经修复了这个特定选项名称的所有充电费
退出Do 
循环
 Else 
退出Do 
结束如果
循环
结束如果
 
退出Sub 
 ErrHandler：'这将错误提升回父子我的电子邮件错误处理程序记录错误
 Err.Raise Err.Number，colOpNaCheck ，Err.Description 
 End Sub 
  

错误13：类型不匹配错误发生在此行将uCell设置为opName
的第一个实例

 将uCell设置为opName 
的第一个实例设置uCell = uRng1.Find（What：= UCase ），LookIn：= xlValues，_ 
 LookAt：= xlPart，SearchOrder = = xlByRows，SearchDirection：= xlNext，_ 
 MatchCase：= False，SearchFormat：= False）
  

发生此错误时， opName 的值为

 订单更改。收到初始采购订单后对订单所做的任何更改都必须通过电子邮件或传真以书面形式进行。每次更改都会收取费用。所有与订单发货相同的更改将被收取。在美国东部标准时间下午3:00之前，必须在美国东部标准时间下午3:00之前收到所有与订单相同的更改。
  

应该找到/替换的值驻留在这两个字符串的中间

  1。PROP：ORDER CHANGES。在采用电子邮件或传真的方式写入初始PO之后，任何更改均可用于书面通知。每笔更改将被罚款。所有更改将在同一天作为订单装运将被罚款。所有更改同一天作为订单装运必须在美国东部时间下午3:00之前收到：每个更改
 2.PROP：订单更改。在采用电子邮件或传真的方式写入初始PO之后，任何更改均可用于书面通知。每笔更改将被罚款。所有更改将在同一天作为订单装运将被罚款。所有更改在同一天作为订单装运必须在美国东部时间下午3:00之前收到：请更改同一天作为订单装运
  

我的问题：

1. 如何解决这个 .Find可以帮助我告诉我如何实现解决方法（s）？



更新：几乎有

感谢Tim的建议和方法，我现在有以下代码

 '将Upcharge列转换为所有大写作为安全协议，
'检查选项名称中的冒号，并从选项名称列和
'upcharge列中删除它们，如果任何升压对应于特定产品的该选项名称
 Private Sub colOpNaCheck （）
 
'Application.StatusBar =（11/16）检查冒号的选项名称
 
 Dim onRng As Range，uRng1 As Range，uRng2 As Range，tempC As Range 
 Dim aCell As Collection，uCell As Collection，el，el2，el3 
 Dim endRange As Long 
 Dim opName As String，opName2 As String，xid As String 
 
 endRange = ActiveSheet.Range（A& Rows.Count）.End（xlUp）.Row 
 
 Set onRng = ActiveSheet.Range（W1：W& endRange）
设置uRng1 = ActiveSheet.Range（CT1：CT & endRange）
设置uRng2 = ActiveSheet.Range（CU1：CU& endRange）
 
设置aCell = FindAllMatches（onRng，：）
 
如果不是aCell是没有，然后
'转换uRng1& uRng2全部大写
'ActiveSheet.Range（uRng1，uRng2）。选择
'对于每个tempC在选择
''如果单元格不包含错误AND不缺少值/是空的AND单元格还没有全部大写
'和行不是1.所有这些检查帮助我们保存处理时间
'如果不是IsError（tempC）而不是IsMissing（tempC）和tempC。值<> UCase（tempC.Value）和tempC.Row 1然后
'tempC.Value = UCase（tempC）
'End If 
'Next tempC 
对于每个el在aCell 
'将冒号添加到开头和结尾字符串，以确保我们只在upcharge列中找到并替换正确的
'部分
 opName =：&价值：
'更正列中的值
 el.Value = Replace（ActiveSheet.Range（W& el.Row）.Value，：，）
'将更正的值（sans-colon）设置为opName2并将冒号添加到开头，
'字符串结束
 opName2 =：&价值：
'注意当前行的XID，所以我们可以确保我们查找正确的upcharge 
 xid = ActiveSheet.Range（A& el.Row）.Value 
 '我们有选项名称和与它相关联的xid 
'现在我们必须在upcharges列中查找是否找到opName 
'然后我们做一个if语句，只执行if列A XID值匹配
'我们现在的当前xid值
 
'将opName的所有实例设置为uCell 
设置uCell = FindAllMatches（uRng1，opName）
如果不是uCell不是然后
对于每个el2在uCell 
'更正列CT 
 el2.Value = Replace（UCase（ActiveSheet.Range（CT& el2。行）.Value），UCase（opName），UCase（opName2））
下一个el2 
如果
 
设置uCell = FindAllMatches（uRng2，opNam e）
如果不是uCell不是然后
对于每个el3在uCell 
'更正列CT 
 el3.Value =替换（UCase（ActiveSheet.Range（CT & ela.Row）.Value），UCase（opName），UCase（opName2））
下一个el3 
结束如果
下一个el 
 
如果
 
 End Sub 
 
函数FindAllMatches（rng As Range，txt As String）As Collection 
 Dim rv As New Collection，f As Range，addr As String，txtSrch As String 
 Dim IsLong As Boolean 
 
 IsLong = Len（txt）> 250 
 txtSrch = IIf（IsLong，Left（txt，250），txt）
 
设置f = rng.Find（what：= txtSrch，lookat：= xlPart，MatchCase：= False） 
做，而不是f没有
如果f.Address（False，False）= addr然后退出Do 
如果Len（addr）= 0然后addr = f.Address（False，False） 
'检查* full *值
如果InStr（f.Value，txt）> 0然后rv.Add f 
设置f = rng.FindNext（after：= f）
循环
设置FindAllMatches = rv 
结束函数
  

但是，当我使用他的函数在upcharge列中找到所有这些实例时，这些行

 '将opName的所有实例设置为uCell 
设置uCell = FindAllMatches（uRng1，opName）
如果不是uCell，则为
。 .. 
  

uCell始终在Watch窗口中显示No Variables，即使是上面提到的值。我究竟做错了什么？或者 FindAllMatches 函数需要调整？

解决方案

功能 FindAllMatches 将返回一个集合，该集合的每个成员都是一个单元格，其中包含要搜索的项目的匹配项。

  Sub Tester（）
 Dim c As Range，col As Collection，el 
 
对于每个c范围内（A1：A3 ）
 
设置col = FindAllMatches（Range（D1：D5），c.Value）
对于每个el in col 
 Debug.Print c.Address& 匹配& el.Address 
下一个el 
 
下一个c 
 
 End Sub 
 
'返回范围中'txt'的所有匹配项的集合'rng'
'如果没有匹配，那么返回的集合的Count属性
'will = zero 
函数FindAllMatches（rng As Range，txt As String）作为集合
 Dim rv作为新集合，f As Range，addr As String，txtSrch As String 
 Dim IsLong As Boolean 
 
 IsLong = Len（txt）> 250 
 txtSrch = IIf（IsLong，Left（txt，250），txt）
 
'EDIT1：添加LookIn参数设置... 
设置f = rng.Find什么：= txtSrch，lookat：= xlPart，_ 
 LookIn：= xlValues，MatchCase：= False）
尽管不是f没有
如果f.Address（False，False）= addr然后退出Do 
如果Len（addr）= 0然后addr = f.Address（False，False）
如果不是IsLong然后
 rv.Add f'总是添加
 Else 
'检查* full *值
'EDIT2：使Instr不区分大小写
如果InStr（1，f.Value，txt，vbTextCompare）> 0然后rv.Add f 
结束Id 
 
设置f = rng.FindNext（之后：= f）
循环
设置FindAllMatches = rv 
结束功能
  

I just released an Excel Add-In in my department today that I've been working on for the last 2+ months that checks for about 30 validation errors. I have the error trapping handled in all situations (as it appears right now), but I received a horrible wake-up call today as I received automatic emails (a feature I built into the error handling) for two vital bugs. The first of which is below, the second I will post separately.

The first bug has to do with the .Find what:= character limitation

The Sub that is throwing this error is as follows

'Converts Upcharge columns to all uppercase as a safety protocol,
'Checks for colons in option names and removes them from the Option Name column and in the
'upcharge columns if any upcharges correspond to that option name for the particular product.
Private Sub colOpNaCheck()
On Error GoTo ErrHandler
Application.StatusBar = "(11/16) Checking option names for colons"

    Dim rng As Range, aCell As Range, uRng1 As Range, uRng2 As Range, uCell As Range, tempC As Range
    Dim endRange As Long
    Dim opName As String, opName2 As String
    Dim xid As String

    endRange = ActiveSheet.Range("A" & Rows.count).End(xlUp).Row

    Set rng = ActiveSheet.Range("W1:W" & endRange)

    Set aCell = rng.Find(What:=":", LookIn:=xlValues, _
                LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
                MatchCase:=False, SearchFormat:=False)

    If Not aCell Is Nothing Then
        'Add colon to beginning and end of string to ensure we only find and replace the right
        'portion over in upcharge column
        opName = ":" & aCell.Value & ":"
        'Correct the value in column W
        aCell = Replace(ActiveSheet.Range("W" & aCell.Row).Value, ":", "")
        'Set corrected value (sans-colon) to opName2 and add colon to beginning and
        'end of string
        opName2 = ":" & aCell.Value & ":"
        'Note the XID of the current row so we can ensure we look for the right upcharge
        xid = ActiveSheet.Range("A" & aCell.Row).Value
        'We have the option name and the xid associated with it
        'Now we have to do a find in the upcharges column to see if we find the opName
        'Then we do an if statement and only execute if the the Column A XID value matches
        'the current xid value we have now
        Set uRng1 = ActiveSheet.Range("CT1:CT" & endRange)
        Set uRng2 = ActiveSheet.Range("CU1:CU" & endRange)

        'Convert uRng1 & uRng2 to all uppercase just to make sure they will be detected when using Find
        ActiveSheet.Range(uRng1, uRng2).Select
        For Each tempC In Selection
            'If cell does not contain an Error AND is not missing a value/is empty AND cell is not already all uppercase
            'AND Row is not 1. All of these checks help us save on processing time
            If Not IsError(tempC) And Not IsMissing(tempC) And tempC.Value <> UCase(tempC.Value) And tempC.Row <> 1 Then
                tempC.Value = UCase(tempC)
            End If
        Next tempC

        'Set uCell to the first instance of opName
        Set uCell = uRng1.Find(What:=UCase(opName), LookIn:=xlValues, _
                LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
                MatchCase:=False, SearchFormat:=False)
        'If there is an instance of opName and uCell has the value check if the xid matches
        'to ensure we 're changing the right upcharge
        Do
            'Check the upcharges
            Set uCell = uRng1.Find(What:=UCase(opName), LookIn:=xlValues, _
                    LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
                    MatchCase:=False, SearchFormat:=False)
            If Not uCell Is Nothing Then
                Do While ActiveSheet.Range("A" & uCell.Row).Value = xid
                    Set uCell = uRng1.Find(What:=UCase(opName), LookIn:=xlValues, _
                            LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
                            MatchCase:=False, SearchFormat:=False)
                    'Correct the value in column CT
                    If Not uCell Is Nothing Then
                        If ActiveSheet.Range("A" & uCell.Row).Value = xid Then
                            uCell = Replace(UCase(ActiveSheet.Range("CT" & uCell.Row).Value), UCase(opName), UCase(opName2))
                        Else
                            Exit Do
                        End If
                    Else
                        Exit Do
                    End If
                Loop
            End If

            'Now we look in upcharge_criteria_2 column
            Set uCell = uRng2.Find(What:=UCase(opName), LookIn:=xlValues, _
                    LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
                    MatchCase:=False, SearchFormat:=False)
            If Not uCell Is Nothing Then
                Do While ActiveSheet.Range("A" & uCell.Row).Value = xid
                    Set uCell = uRng2.Find(What:=UCase(opName), LookIn:=xlValues, _
                            LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
                            MatchCase:=False, SearchFormat:=False)
                    'Correct the value in column CU
                    If Not uCell Is Nothing Then
                        If ActiveSheet.Range("A" & uCell.Row).Value = xid Then
                            uCell = Replace(UCase(ActiveSheet.Range("CU" & uCell.Row).Value), UCase(opName), UCase(opName2))
                        Else
                            Exit Do
                        End If
                    Else
                        Exit Do
                    End If
                Loop
            End If
        'Exit the Do Statement since we've fixed all the upcharges for this particular Option Name
        Exit Do
        Loop

        Do
            'Check for Options
            Set aCell = rng.Find(What:=":", LookIn:=xlValues, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
                MatchCase:=False, SearchFormat:=False)
            If Not aCell Is Nothing Then
                'Add colon to beginning and end of string to ensure we only find and
                'replace the right portion over in upcharge column
                opName = ":" & aCell.Value & ":"
                'Correct the value in column W (Option_Name)
                aCell = Replace(ActiveSheet.Range("W" & aCell.Row).Value, ":", "")
                'Set corrected value (sans-colon) to opName2 and add colon to
                'beginning and end of string
                opName2 = ":" & aCell.Value & ":"
                'Note the XID of the current row so we can ensure we look for the right upcharge
                xid = ActiveSheet.Range("A" & aCell.Row).Value
                Do
                    'Check the upcharges
                    Set uCell = uRng1.Find(What:=UCase(opName), LookIn:=xlValues, _
                            LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
                            MatchCase:=False, SearchFormat:=False)
                    If Not uCell Is Nothing Then
                        Do While ActiveSheet.Range("A" & uCell.Row).Value = xid
                            Set uCell = uRng1.Find(What:=UCase(opName), LookIn:=xlValues, _
                                    LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
                                    MatchCase:=False, SearchFormat:=False)
                                'Correct the value in column CT
                            If Not uCell Is Nothing Then
                                If ActiveSheet.Range("A" & uCell.Row).Value = xid Then
                                    uCell = Replace(UCase(ActiveSheet.Range("CT" & uCell.Row).Value), UCase(opName), UCase(opName2))
                                Else
                                    Exit Do
                                End If
                            Else
                                Exit Do
                            End If
                        Loop
                    End If

                    'Now we look in upcharge_criteria_2 column
                    Set uCell = uRng2.Find(What:=UCase(opName), LookIn:=xlValues, _
                            LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
                            MatchCase:=False, SearchFormat:=False)
                    If Not uCell Is Nothing Then
                        Do While ActiveSheet.Range("A" & uCell.Row).Value = xid
                            Set uCell = uRng2.Find(What:=UCase(opName), LookIn:=xlValues, _
                                    LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
                                    MatchCase:=False, SearchFormat:=False)
                            'Correct the value in column CU
                            If Not uCell Is Nothing Then
                                If ActiveSheet.Range("A" & uCell.Row).Value = xid Then
                                    uCell = Replace(UCase(ActiveSheet.Range("CU" & uCell.Row).Value), UCase(opName), UCase(opName2))
                                Else
                                    Exit Do
                                End If
                            Else
                                Exit Do
                            End If
                        Loop
                    End If
                    'Exit the Do Statement since we've fixed all the upcharges for this particular Option Name
                    Exit Do
                Loop
            Else
                Exit Do
            End If
        Loop
    End If

    Exit Sub
ErrHandler: 'This raises the error back to the parent Sub where my Email on error handler records the error
    Err.Raise Err.Number, "colOpNaCheck", Err.Description
End Sub

The Error 13: Type Mismatch error occurs on this line

'Set uCell to the first instance of opName
            Set uCell = uRng1.Find(What:=UCase(opName), LookIn:=xlValues, _
                    LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
                    MatchCase:=False, SearchFormat:=False)

When this error occurs the value of opNameis

"Order Changes. Any changes made to orders after receipt of initial PO must be made in writing via e-mail or fax. Each change will be billed. All changes made the same day as order shipment will be billed. All changes made the same day as order shipment must be received before 3:00 pm EST."

And the values it should be finding/replacing reside in the middle of these two strings

1. "PROP:ORDER CHANGES. ANY CHANGES MADE TO ORDERS AFTER RECEIPT OF INITIAL PO MUST BE MADE IN WRITING VIA E-MAIL OR FAX. EACH CHANGE WILL BE BILLED. ALL CHANGES MADE THE SAME DAY AS ORDER SHIPMENT WILL BE BILLED. ALL CHANGES MADE THE SAME DAY AS ORDER SHIPMENT MUST BE RECEIVED BEFORE 3:00 PM EST.:EACH CHANGE"
2. "PROP:ORDER CHANGES. ANY CHANGES MADE TO ORDERS AFTER RECEIPT OF INITIAL PO MUST BE MADE IN WRITING VIA E-MAIL OR FAX. EACH CHANGE WILL BE BILLED. ALL CHANGES MADE THE SAME DAY AS ORDER SHIPMENT WILL BE BILLED. ALL CHANGES MADE THE SAME DAY AS ORDER SHIPMENT MUST BE RECEIVED BEFORE 3:00 PM EST.:ALL CHANGES MADE THE SAME DAY AS ORDER SHIPMENT"

My Questions:

1. How can I work around this .Find what:= limitation while making as few adjustments as possible to my code?
2. Could you help show me how I could implement the workaround method(s)?

Update: Almost There

Thanks to Tim's advice and method I now have the following code

'Converts Upcharge columns to all uppercase as a safety protocol,
'Checks for colons in option names and removes them from the Option Name column and in the
'upcharge columns if any upcharges correspond to that option name for the particular product.
Private Sub colOpNaCheck()

'Application.StatusBar = "(11/16) Checking option names for colons"

    Dim onRng As Range, uRng1 As Range, uRng2 As Range, tempC As Range
    Dim aCell As Collection, uCell As Collection, el, el2, el3
    Dim endRange As Long
    Dim opName As String, opName2 As String, xid As String

    endRange = ActiveSheet.Range("A" & Rows.Count).End(xlUp).Row

    Set onRng = ActiveSheet.Range("W1:W" & endRange)
    Set uRng1 = ActiveSheet.Range("CT1:CT" & endRange)
    Set uRng2 = ActiveSheet.Range("CU1:CU" & endRange)

    Set aCell = FindAllMatches(onRng, ":")

    If Not aCell Is Nothing Then
    'Convert uRng1 & uRng2 to all uppercase
'            ActiveSheet.Range(uRng1, uRng2).Select
'            For Each tempC In Selection
'                'If cell does not contain an Error AND is not missing a value/is empty AND cell is not already all uppercase
'                'AND Row is not 1. All of these checks help us save on processing time
'                If Not IsError(tempC) And Not IsMissing(tempC) And tempC.Value <> UCase(tempC.Value) And tempC.Row <> 1 Then
'                    tempC.Value = UCase(tempC)
'                End If
'            Next tempC
        For Each el In aCell
            'Add colon to beginning and end of string to ensure we only find and replace the right
            'portion over in upcharge column
            opName = ":" & el.Value & ":"
            'Correct the value in column W
            el.Value = Replace(ActiveSheet.Range("W" & el.Row).Value, ":", "")
            'Set corrected value (sans-colon) to opName2 and add colon to beginning and
            'end of string
            opName2 = ":" & el.Value & ":"
            'Note the XID of the current row so we can ensure we look for the right upcharge
            xid = ActiveSheet.Range("A" & el.Row).Value
            'We have the option name and the xid associated with it
            'Now we have to do a find in the upcharges column to see if we find the opName
            'Then we do an if statement and only execute if the Column A XID value matches
            'the current xid value we have now

            'set all instances of opName to uCell
            Set uCell = FindAllMatches(uRng1, opName)
            If Not uCell Is Nothing Then
                For Each el2 In uCell
                'Correct the value in column CT
                el2.Value = Replace(UCase(ActiveSheet.Range("CT" & el2.Row).Value), UCase(opName), UCase(opName2))
                Next el2
            End If

            Set uCell = FindAllMatches(uRng2, opName)
            If Not uCell Is Nothing Then
                For Each el3 In uCell
                'Correct the value in column CT
                el3.Value = Replace(UCase(ActiveSheet.Range("CT" & el3.Row).Value), UCase(opName), UCase(opName2))
                Next el3
            End If
    Next el

End If

End Sub

Function FindAllMatches(rng As Range, txt As String) As Collection
    Dim rv As New Collection, f As Range, addr As String, txtSrch As String
    Dim IsLong As Boolean

    IsLong = Len(txt) > 250
    txtSrch = IIf(IsLong, Left(txt, 250), txt)

    Set f = rng.Find(what:=txtSrch, lookat:=xlPart, MatchCase:=False)
    Do While Not f Is Nothing
        If f.Address(False, False) = addr Then Exit Do
        If Len(addr) = 0 Then addr = f.Address(False, False)
        'check for the *full* value
        If InStr(f.Value, txt) > 0 Then rv.Add f
        Set f = rng.FindNext(after:=f)
    Loop
    Set FindAllMatches = rv
End Function

However, when I use his function to find all the instances over in the upcharge column with these lines

'set all instances of opName to uCell
 Set uCell = FindAllMatches(uRng1, opName)
 If Not uCell Is Nothing Then
 ...

uCell is always displaying No Variables in the Watch window, even with the value I stated above. What am I doing wrong? Or does the FindAllMatches function need to be adjusted?

解决方案

The function FindAllMatches will return a Collection, with each member of that collection being a cell which contains a match for the item being searched for.

Sub Tester()
    Dim c As Range, col As Collection, el

    For Each c In Range("A1:A3")

        Set col = FindAllMatches(Range("D1:D5"), c.Value)
        For Each el In col
            Debug.Print c.Address & " matched " & el.Address
        Next el

    Next c

End Sub

'Return a collection of all matches for 'txt' in Range 'rng'
'  If no matches then the Count property of the returned collection
'    will  = zero
Function FindAllMatches(rng As Range, txt As String) As Collection
    Dim rv As New Collection, f As Range, addr As String, txtSrch As String
    Dim IsLong As Boolean

    IsLong = Len(txt) > 250
    txtSrch = IIf(IsLong, Left(txt, 250), txt)

   'EDIT1: added the LookIn parameter setting...
    Set f = rng.Find(what:=txtSrch, lookat:=xlPart, _
                     LookIn:=xlValues, MatchCase:=False)
    Do While Not f Is Nothing
        If f.Address(False, False) = addr Then Exit Do
        If Len(addr) = 0 Then addr = f.Address(False, False)
        If Not IsLong Then
            rv.Add f 'always add
        Else
            'check for the *full* value
            'EDIT2: make the Instr case-insensitive
             If InStr(1, f.Value, txt, vbTextCompare) > 0 Then rv.Add f
        End Id

        Set f = rng.FindNext(after:=f)
    Loop
    Set FindAllMatches = rv
End Function

这篇关于如何解决excel vba中的Find（what：=）字符限制的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！