Question

下面的代码根据A列中的值创建一个唯一值数组。每个选定的数组元素用于选择工作表上的范围。范围显示在用户表单列表框中。

我想帮助代码，允许用户通过两个表单按钮Right'＆gt;＆gt;'和Left'＆lt;＆lt;'滚动每个数组'MyarUniqVal'元素。每次按下按钮时，将选择一个顺序数组项目，新的范围将填充列表框。

任何帮助将不胜感激。

谢谢，

请参阅以下代码：

    Sub testRange3()

    Dim lastrow, i, j As Long
    Dim c As Range, rng As Range
    Dim MyArUniqVal() As Variant


ReDim MyArUniqVal(0)
'With ActiveSheet
 With ThisWorkbook.Worksheets("Temp")

    lastrow = .Cells(.Rows.Count, "A").End(xlUp).Row

    For i = 1 To lastrow
        If .Cells(i, 1).Value <> .Cells(i + 1, 1).Value Then
            MyArUniqVal(UBound(MyArUniqVal)) = .Cells(i, 1).Value
            ReDim Preserve MyArUniqVal(UBound(MyArUniqVal) + 1)
        End If
    Next
    ReDim Preserve MyArUniqVal(UBound(MyArUniqVal) - 1)
End With

For j = LBound(MyArUniqVal) To UBound(MyArUniqVal)
'Prints out each array to Immediate Window
    Debug.Print j
'Prints out unique values from Column A stored in array to Immediate Window
    Debug.Print MyArUniqVal(j)
Next


With ThisWorkbook.Worksheets("Temp")
'changed to ActiveSheet
    'With ActiveSheet
        For Each c In .Range("A1:A" & lastrow)
For j = LBound(MyArUniqVal) To UBound(MyArUniqVal)
    If UCase(c.Text) = j Then
                'If UCase(c.Text) = "B" Then
                    If rng Is Nothing Then
                        Set rng = .Range("B" & c.Row).Resize(, 2)
                        Debug.Print rng
                    Else
                        Set rng = Union(rng, .Range("B" & c.Row).Resize(, 2))
                        Exit For
                        Debug.Print rng
                    End If
                End If
           Next
        Next c
    End With

    If Not rng Is Nothing Then rng.Select

End Sub

Answer 1

请参阅以下代码，以帮助您找到正确的方向。我采用了添加另一个显示可用前缀的列表框的方法，以帮助用户查看可用的内容，然后在数据列中搜索包含所选前缀的条目。

希望您能够将变量和对象的名称调整为您当前使用的任何名称。如果有任何需要澄清，请告诉我。祝你的项目好运。

我的示例表单代码：

Private Sub cmdBack_Click()

    code_frmMain.IncrementValue (0)

End Sub

Private Sub cmdNext_Click()

    code_frmMain.IncrementValue (1)

End Sub

Private Sub lstPrefixes_Change()

    code_frmMain.DisplayNext

End Sub   

Private Sub UserForm_Initialize()

    code_frmMain.testRange3

End Sub

我的示例程序代码：

'  This subroutine will search column B for the selected value
Sub DisplayNext()

    Dim searchTerm As String
    Dim lastRow As Long
    Dim i As Integer

    ' clear frmMain.lstResults
    frmMain.lstResults.Clear

    For i = 0 To frmMain.lstPrefixes.ListCount - 1

         If frmMain.lstPrefixes.Selected(i) = True Then

            searchTerm = frmMain.lstPrefixes.List(i)
            Exit For   ' exits once selected item is found

         End If

    Next i

    'Debug.Print searchTerm

    With Sheets("Temp")
        lastRow = .Range("A" & .Rows.Count).End(xlUp).Row
    End With


    For i = 1 To lastRow

        If InStr(Cells(i, 2).Value, searchTerm) Then

            frmMain.lstResults.AddItem (Cells(i, 2).Value)

        End If

    Next i

End Sub

' increments value. input direction: 0 is down and 1 is up
Sub IncrementValue(direction As Integer)

    Dim currentIndex As Integer
    currentIndex = -1

    For i = 0 To frmMain.lstPrefixes.ListCount - 1

         If frmMain.lstPrefixes.Selected(i) = True Then

            currentIndex = frmMain.lstPrefixes.ListIndex
            Exit For   ' exits once selected item is found

         End If

    Next i

    ' defaults to first item if none selected
    If currentIndex = -1 Then
        frmMain.lstPrefixes.Selected(0) = True
        currentIndex = 0
    End If


    If direction = 0 Then

        ' prevents listIndex from being invalid
        If currentIndex = 0 Then

            frmMain.lstPrefixes.Selected(frmMain.lstPrefixes.ListCount - 1) = True

        Else

            frmMain.lstPrefixes.Selected(currentIndex - 1) = True

        End If

    Else

        If currentIndex = frmMain.lstPrefixes.ListCount - 1 Then

            frmMain.lstPrefixes.Selected(0) = True

        Else

            frmMain.lstPrefixes.Selected(currentIndex + 1) = True

        End If

    End If

End Sub

请注意，我还将其添加到testRange3（）的底部以使用您已收集的数据：

For i = 0 To UBound(MyArUniqVal)

    frmMain.lstPrefixes.AddItem (MyArUniqVal(i))

Next i

示例数据：

在用户表单上运行：

遍历顺序数组项

1 个答案: