Question

我试图弄清楚如何在动态设置中解决InStr函数的通配符解决方案。

目前我正在使用以下代码（基于下图中的示例）循环访问数据：

Sub Test()
 Dim Rng_Target As Range
 Dim Rng_Data As Range
 Dim RCntr_Target As Long
 Dim RCntr_Data As Long
 Dim Str_Tgt As String

    Set Rng_Target = Range("E2:E3")
    Set Rng_Data = Range("A2:C15")

    For RCntr_Target = 0 To Rng_Target.Rows.Count

        Str_Tgt = Rng_Target(RCntr_Target) & "High" & Rng_Target(RCntr_Target) & "Major"

        For RCntr_Data = 0 To Rng_Data.Rows.Count

            If InStr(1, Str_Tgt, Rng_Data(RCntr_Target, 1) & Rng_Data(RCntr_Target, 2)) > 0 Then

                If Rng_Data(RCntr_Target, 3) < 0.9 Then

                    ' Do something

                End If

            End If

        Next RCntr_Data

    Next RCntr_Target

End Sub

此设置适用于我的10个设置中的9个，但它无法处理 预定位标记 ，例如＆＃34; 绿色_ ＆＃34;

见下面的简化示例图片。有没有办法可以跳过匹配字符串中第一个X号码（需要是动态的）？

您需要记住一些事情

有+5.000行，有许多不同的目标，所以它需要是动态的。
如果A列与目标部分匹配，则应包括数据，B列为High或Major。结果在 Target1 框和 Target2 框中说明。
有许多 预定标记 ，例如＆＃34;的绿_ ＆＃34;我不会在上面注册。
如上所述，有多种代码构造，如果我需要拆分InStr函数或者在函数中混合更多，这将是非常有问题的。

e.g：

If InStr(1, Rng_Target(RCntr_Target), Rng_Data(RCntr_Target, 1)) > 0 Then

    If InStr(1, "HighMajor", Rng_Data(RCntr_Target, 2)) > 0 Then

        If Rng_Data(RCntr_Target, 3) < 0.9 Then

            ' Do something

        End If

    End If

End If

Answer 1

我很难理解你的代码想要完成什么，但我得到了你所遇到的问题的要点。我试图提出一个代码示例（希望）完成您的任务，但也使您的代码更清晰。见下文：

首先，我们创建一个自定义函数来返回一个干净的产品名称：

Private Function GetProductName(ByVal InputProductName As String) As String
    Dim ProductName As String

    If InStr(1, InputProductName, "_") > 0 Then
        ProductName = Split(InputProductName, "_")(1)
    Else
        ProductName = InputProductName
    End If

    GetProductName = ProductName
End Function

这样做需要输入字符串，并检查下划线“_”。如果有下划线，则返回输入字符串的第二部分。如果没有，则只返回字符串本身。

然后我们就有了例行公事：

    Sub FilterProducts()
        Dim InputData As Variant

        ' Point this to the range where you input data is. If only your input data is on the sheet then use the UsedRange version (for simplicity).
        ' InputData = ThisWorkbook.Sheets("ProductInformation").UsedRange.Value
        InputData = ThisWorkbook.Sheets("ProductInformation").Range("A1:C15").Value

        ' To keep this dynamic I use a Scripting.Dictionary trick to dynamically find the headers I am interested in.
        Dim HeaderIndices As Scripting.Dictionary
        Set HeaderIndices = New Scripting.Dictionary

        Dim i As Long
        For i = LBound(InputData, 2) To UBound(InputData, 2)
            ' Basically we are looping from the lowest column, to the highest column.
            ' We then check if that header exists within the dictionary, and if it doesn't
            ' we add the header as a key, with the index as the item.
            If Not HeaderIndices.Exists(InputData(LBound(InputData, 1), i)) Then
                HeaderIndices.Add InputData(LBound(InputData, 1), i), i
            End If
        Next

        ' Now we will loop row-wise through the data to find the data we are interested in.
        Dim ProductName As String
        For i = LBound(InputData, 1) + 1 To UBound(InputData, 1)
            ' Our row index is i (since we are looping from top to bottom)
            ' Our column index is retrieved from the dictionary under the key of
            ' "Fruit". You would want to change this to match the actual column name
            ' in your input data.
            ProductName = GetProductName(InputData(i, HeaderIndices("Fruit")))

            If InputData(i, HeaderIndices("Probability")) = "High" Or _
            InputData(i, HeaderIndices("Probability")) = "Major" Then
                If InputData(i, HeaderIndices("Value")) < 0.9 Then
                    ' Do Something
                    ' This is where you will want to figure out your process for creating the output.
                    ' I would personally suggest learning about arrays.
                    Debug.Print "Product Name: " & ProductName & vbNewLine & vbNewLine & _
                                "Probability: " & InputData(i, HeaderIndices("Probability")) & vbNewLine & vbNewLine & _
                                "Value : " & InputData(i, HeaderIndices("Value"))
                End If
            End If
        Next
    End Sub

我尝试为此添加注释，以使其尽可能清晰。如果你想使用静态索引，可以删除其中一些（但我建议学习更动态的方法）。这将采用输入范围，并循环查找“Fruit”“Probability”和“Value”的数据。然后它会将匹配的产品打印到控制台（更改此部分以满足您的需求）。

最后，为了使用Scripting.Dictionaries，您需要Late或Early绑定。我更喜欢早期绑定（使用引用），所以这里是我用于此目的的代码。

' You can put this in your Workbook.Open routine if you are sharing the workbook, or you can run it as a command from the immediate window.

AddReferencebyGUID "{420B2830-E718-11CF-893D-00A0C9054228}"

' If you do use the Workbook.Open Event, use this code:
If CheckForAccess Then
    RemoveBrokenReferences
    AddReferencebyGUID "{420B2830-E718-11CF-893D-00A0C9054228}"
End If

Private Sub RemoveBrokenReferences()
    ' Reference is a Variant here since it requires an external reference.
    ' It isnt possible to ensure that the external reference is checked when this process runs.
    Dim Reference As Variant
    Dim i As Long

    For i = ThisWorkbook.VBProject.References.Count To 1 Step -1
        Set Reference = ThisWorkbook.VBProject.References.Item(i)
        If Reference.IsBroken Then
            ThisWorkbook.VBProject.References.Remove Reference
        End If
    Next i
End Sub

Public Function CheckForAccess() As Boolean
    ' Checks to ensure access to the Object Model is set
    Dim VBP As Variant
    If Val(Application.Version) >= 10 Then
        On Error Resume Next
        Set VBP = ThisWorkbook.VBProject
        If Err.Number <> 0 Then
            MsgBox "Please pay attention to this message." _
                 & vbCrLf & vbCrLf & "Your security settings do not allow this procedure to run." _
                 & vbCrLf & vbCrLf & "To change your security setting:" _
                 & vbCrLf & vbCrLf & " 1. Select File - Options - Trust Center - Trust Center Settings - Macro Settings." & vbCrLf _
                 & " 2. Place a checkmark next to 'Trust access to the VBA project object model.'" _
                 & vbCrLf & "Once you have completed this process, please save and reopen the workbook." _
                 & vbCrLf & "Please reach out for assistance with this process.", _
                   vbCritical
            CheckForAccess = False
            Err.Clear
            Exit Function
        End If
    End If
    CheckForAccess = True
End Function

引用的代码严格用于绑定（可能超出了您迄今为止学到的内容）。您可以复制并粘贴该代码，但不会有任何问题。我建议花更多的时间来学习主程序是如何工作的，这样你就可以在将来复制这个过程。

如果您有任何疑问，请与我们联系。

VBA InStr函数在循环中限制匹配变通方法

1 个答案: