Перемещение по элементам последовательного массива

Question

Код ниже создает массив уникальных значений из значений в столбце A. Каждый выбранный элемент массива используется для выбора диапазона на листе. Диапазон отображается в списке Userform Listbox.

Я хотел бы помочь с кодом, который позволит пользователю прокручивать через каждый элемент массива «MyarUniqVal» через две кнопки формы Right «>>» и «Left < <». Каждый раз, когда нажимается кнопка, будет выбран элемент последовательного массива, а новый диапазон заполнит список.

Любая помощь была бы принята с благодарностью.

Спасибо,

Пожалуйста, смотрите код ниже:

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 

Мой образец программного кода:

, что я добавил это к нижней части testRange3 (

' 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 

Примечание), чтобы использовать эти данные, которые вы должны были уже собрались:

For i = 0 To UBound(MyArUniqVal) 

    frmMain.lstPrefixes.AddItem (MyArUniqVal(i)) 

Next i 

образец данных:

Запуск на пользовательской форме: