Кнопка Excel, которая показывает элементы предыдущего ряда

Question

Я использовал код из { ссылка }
Я получил его для использования длины столбца динамического c и получения значений из ячейки на другом листе. Этот код в настоящее время дает мне элемент следующей строки (т. Е. A1 -> click -> A2), а затем, если последний элемент, возвращается к первому.
Знайте, что мне нужно это go в обратном направлении. Ему нужно go снизу вверх, а если попадет первый, go - последний. Я попытался изменить параметры Range, но получил ошибку.
Любые идеи или советы будут очень полезны.

Sub Button8_Click()
    Set wsh = ActiveWorkbook.Worksheets("Sheet1")
    Column = wsh.Range("A" & Rows.Count).End(xlUp).Row

    If IsError(Application.Match(Range("B2").Value, wsh.Range(wsh.Cells(2, 1), wsh.Cells(Column, 1)), 0)) Then
        Range("B2").Value = wsh.Cells(2, 1).Value
    ElseIf Application.Match(Range("B2").Value, wsh.Range(wsh.Cells(2, 1), wsh.Cells(Column, 1)), 0) = wsh.Range(wsh.Cells(2, 1), wsh.Cells(Column, 1)).Cells.Count Then
        Range("B2").Value = wsh.Cells(2, 1).Value
    Else
        Range("B2").Value = wsh.Cells(2, 1).Offset(Application.Match(Range("B2").Value, wsh.Range(wsh.Cells(2, 1), wsh.Cells(Column, 1)), 0), 0).Value
    End If
End Sub

Answer 1

Я считаю ваш код громоздким (или, возможно, недостаточно сложным :-)). Вот другая версия. Работает по двойному клику на А1. Его необходимо установить в листе кода рабочей таблицы, на которой вы хотите выполнить действие.

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)

    Const Rstart As Long = 2                ' set as required

    Dim Rng As Range
    Dim Rcount As Long
    Dim R As Variant

    With Target
        If .Address = Range("A1").Address Then
            ' from Rstart to last row in column B
            Set Rng = Range(Cells(Rstart, "B"), Cells(Rows.Count, "B").End(xlUp))
            Rcount = Rng.Cells.Count

            On Error Resume Next
            R = Application.Match(.Value, Rng, 0)
            If Err Then
                R = Rcount
            Else
                R = R + 1
                If R > Rcount Then R = 1
            End If

            .Value = Rng.Cells(R).Value

            .Offset(1).Select
        End If
    End With
End Sub

Как только вы поймете код, его будет легче читать и изменять. Например, чтобы изменить ячейку A1, все, что вам нужно сделать, это изменить ссылку на A1 в этой строке кода. Если .Address = Range ("A1"). Адрес .

Ваш список вариантов не обязательно должен начинаться со строки 1. Const Rstart теперь имеет значение 2, что означает, что ваш список начинается со строки 2, с учетом заголовка столбца, но вы можете изменить если хотите, выберите 1 или 3.

Строка кода Установите Rng = Range (Ячейки (Rstart, "B"), Ячейки (Rows.Count, "B"). Конец (xlUp)) устанавливает диапазон вашего списка в столбец B. Измените два символа "B", чтобы переместить его в другой столбец. Он находит конец динамически. Начало взято из настройки Rstart .

Наконец, нет кнопки. Но если вы предпочитаете, чтобы кнопка дважды щелкала по кнопке, вам будет легко адаптировать код для ее использования.

Что было бы хорошо для «наконец», если бы не было еще одного слова, которое можно было бы сказать. Этот код можно легко адаптировать, чтобы иметь разные триггеры, ссылающиеся на разные списки на одном листе. Например, вы можете переместить список сейчас в столбце B, чтобы он был ниже A1. В столбце B у вас может быть другой список, который реагирует на двойной щелчок в B1 et c.

Answer 2

Если вы абсолютно уверены, что дубликатов нет, вы можете использовать метод Range.Find, который является встроенной функцией VBA.

Option Explicit
Private Sub CommandButton1_Click()
    Dim rDest As Range, rCol As Range, C As Range
    Dim wsSrc As Worksheet
    Dim myRow As Long, LR As Long

Set wsSrc = Worksheets("sheet2") 'or whatever

With wsSrc
    Set rCol = .Range(.Cells(1, 1), .Cells(.Rows.Count, 1).End(xlUp))
End With

Set rDest = Cells(2, 2)

With rCol
    Set C = .Find(what:=rDest, after:=rCol(1, 1), LookIn:=xlValues, _
                lookat:=xlWhole, searchorder:=xlByRows, searchdirection:=xlPrevious)
    If Not C Is Nothing Then
      If C.Row = 1 Then Set C = rCol(rCol.Rows.Count + 1, 1)
        rDest = C.Offset(-1, 0)
    Else
        rDest = rCol(rCol.Rows.Count, 1)
    End If
End With
End Sub