Question

当我运行此代码时，如果我得到一个匹配而不是将它放入豺（1）或豺（2），它将它放入Jackal（1）（0）或Jackal（2）（0）。如何重写此代码以便将值直接放入jackal（1）？也许它是我的过滤函数的语法？

Sub cmov2()
'This macro is designed to sniff out multiple selection incompatibilities; specifically     if you choose a L/R Monitor Arm with L/R Swing Light it will Warn.
'Code Section#1: Find if any of the following are on the order EDS-3090, BDS-2530, or     BDS-2589

Dim valid() As String
ReDim valid(1 To 3)
valid(1) = "EDS-3090"
valid(2) = "BDS-2530"
valid(3) = "BDS-2589"
Sheets("Config").Columns("B:B").Select
Selection.Find(What:="1", After:=ActiveCell, LookIn:=xlFormulas, LookAt _
    :=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
    False, SearchFormat:=False).Activate
 ActiveCell.Select
 rowq = ActiveCell.row
 Selection.End(xlDown).Select
 rowp = ActiveCell.row
 Range("F" & rowq).Select
 Dim Stern() As String
 ReDim Stern(1 To rowp - rowq)
 zea = 1
 Do
 Stern(zea) = Selection.Value
 Selection.Offset(1, 0).Select
 zea = zea + 1
 Loop Until zea = (rowp - rowq)
 Dim quack As Integer
 quack = 1
  Dim jackal() As Variant
 ReDim jackal(1 To 3)
 Do
 Stop
 zee = Filter(Stern(), valid(quack))
 jackal(quack) = z
 quack = quack + 1
 Loop Until quack = 3
' This code creates the wrong structure for this variable i get jackal(1)(0) and things        'like that. Would prefer to check jackal( 1 to end) for <> nullstring
 If jackal(1)(0) = vbNullString Then
    'change to y=1 do if jackal(y)<>vbnullstring then
    'msgbox "warning"

 Exit Sub
 Else
 MsgBox "Warning: You have a selection with two swingarms that are on the same radius and cannot swing past one another " & Chr$(13) & " Choose Okay if you still wish to proceed otherwise choose Cancel to revise your order", vbOKCancel
 End If
End Sub

Answer 1

我是这样做的：

Sub cmov2()


    Dim valid, i
    Dim rng As Range, f As Range, rngProb As Range

    valid = Array("EDS-3090", "BDS-2530", "BDS-2589")

    'what is the purpose of Find() here?
    Set f = Sheets("Config").Columns("B:B").Find(what:="1", After:=ActiveCell, _
                     LookIn:=xlFormulas, lookat:=xlPart, MatchCase:=False)

    If f Is Nothing Then Exit Sub 'not found - could this happen?

    Set rng = f.Parent.Range(f, f.End(xlDown))

    For i = LBound(valid) To UBound(valid)

        Set f = rng.Find(what:=valid(i), LookIn:=xlValues, lookat:=xlWhole)
        If Not f Is Nothing Then
            If rngProb Is Nothing Then
                Set rngProb = f
            Else
                Set rngProb = Application.Union(rngProb, f)
            End If
        End If

    Next i

    If Not rngProb Is Nothing Then
        'Msgbox "..."                  'warn about problem
        rngProb.Parent.Activate        'show the sheet
        rngProb.Interior.Color = vbRed 'highlight problem values
    End If

End Sub

Answer 2

我接受了你的建议Tim这就是我得到的：我因为类型不匹配错误而陷入过滤器功能。我不明白为什么。

Option Explicit
Sub cmov2()
'This macro is designed to sniff out multiple selection incompatibilities; specifically    if you choose a L/R Monitor Arm with L/R Swing Light it will Warn.
'Code Section#1: Find if any of the following are on the order EDS-3090, BDS-2530, or BDS-2589

Dim valid() As String
ReDim valid(1 To 3)
Dim rowq As Integer
Dim rowp As Integer
Dim counter As Integer
Dim compare As String
 Dim quack As Integer
valid(1) = "EDS-3090"
valid(2) = "BDS-2530"
valid(3) = "BDS-2589"
 Sheets("Config").Columns("B:B").Select 
 Selection.Find(What:="1", After:=ActiveCell, LookIn:=xlFormulas, LookAt _
    :=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
    False, SearchFormat:=False).Activate
 ActiveCell.Select
 rowq = ActiveCell.row
 Selection.End(xlDown).Select
 rowp = ActiveCell.row
 Range("F" & rowq).Select
 Dim Stern() As String
 ReDim Stern(1 To rowp - rowq)
 counter = 1
 Do
 Stern(counter) = Selection.Value
 Selection.Offset(1, 0).Select
 counter = counter + 1
 Loop Until counter = (rowp - rowq)
 quack = 1
  Dim jackal As String

    Do
 Stop
 compare = Filter(Stern(), valid(quack), True)
 quack = quack + 1
 Loop Until quack = 3
 If jackal = vbNullString Then
 Exit Sub
 Else
 MsgBox "Warning: You have a selection with two swingarms that are on the same radius and cannot swing past one another " & Chr$(13) & " Choose Okay if you still wish to proceed otherwise choose Cancel to revise your order", vbOKCancel
 End If
End Sub

改变变量结构以避免变量（）（）结构

2 个答案: