Нажатие на кнопку для переключения между значениями диапазона

Question

Я пытаюсь создать кнопку для автоматического заполнения ячейки B5 информацией из ячеек другого листа A1:A10 .

Когда кнопка нажата, я хочу, чтобы B5 содержал информацию из ячейки A1 . Затем, когда кнопка будет нажата снова, она должна содержать информацию из A2 и так далее.

Answer 1

Вот короткий простой метод.

Вам понадобится счетчик для увеличения с каждым нажатием кнопки. Вам нужно будет поместить это где-то в таблицу, для этого примера она находится ниже кнопки.

1. Сначала решите, куда будет идти ваш счетчик, для этого примера он будет находиться непосредственно под кнопкой.

2. Вставьте свою кнопку.

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

4. Вставьте приведенный ниже код в VBA Editor для нажатия кнопки.

Код

Sub Button1_Click()

    Dim CopySheet As Worksheet, PasteSheet As Worksheet
    Dim xFrom As Integer, xTo As Integer, i As Integer
    Dim pasteCell As String, cCell As String

    'Sheets
    Set CopySheet = Worksheets("Sheet2") 'Sheet you are copying from.
    Set PasteSheet = Worksheets("Sheet1")  'Sheet you are pasting into.

    'Rows, range of rows start from row rStart to rEnd
    rStart = 1 'Start of Row you want to copy from.
    rEnd = 10 'End of Row you want to copy from.

    'Cells
    pasteCell = "B5" 'Cell we will paste data from CopySheet.

    'Counter will increments with each button press.
    cCell = "E5" 'Change "E5" to reference cell on your spreadsheet.
    i = Range(cCell).Value

    Application.ScreenUpdating = False 'We disable Screen Updating to prevent interruption.

    'Update Counter
    i = i + 1
    If (i > rEnd) Then
        i = rStart
    End If
    Range(cCell).Value = i

    'Copy/Paste Functions
    CopySheet.Select
    Range("A" & i).Select
    Selection.Copy
    PasteSheet.Select
    Range(pasteCell).Select
    ActiveSheet.Paste

    Application.ScreenUpdating = True 'Enable Screen Updating at end of operation.
End Sub

Кнопка будет копироваться на основе номера счетчика плюс 1, поэтому, если на кнопке нажата цифра 0, макрос добавит, получает 0 + 1, затем запустит функции копирования и вставки.

Answer 2

Нет необходимости хранить счетчик в ячейке рабочей книги. Вместо этого вы можете использовать статическую переменную.

Вставьте следующий код в любой не классовый модуль:

'============================================================================================
' Module     : <any non-class module>
' Version    : 0.1.1
' Part       : 1 of 1
' References : N/A
' Source     : https://superuser.com/a/1331173/763880
'============================================================================================

Option Explicit

Public Sub Next_Click()

  Const s_DestSheet As String = "Sheet1"
  Const s_DestRange As String = "B5"
  Const s_SrcSheet As String = "Sheet2"
  Const s_SrcCell As String = "A1:A10"

  Static sidxCurrentCell As Variant: If IsEmpty(sidxCurrentCell) Then sidxCurrentCell = -1

  With Worksheets(s_SrcSheet).Range(s_SrcCell)
    sidxCurrentCell = (sidxCurrentCell + 1) Mod .Cells.Count
    .Cells(sidxCurrentCell + 1).Copy Destination:=Worksheets(s_DestSheet).Range(s_DestRange)
  End With

End Sub

Затем назначьте его на свою кнопку.

Единственная проблема с этим кодом заключается в том, что он не запоминает, в какой ячейке он находился при повторном открытии книги, и перезапускается с первой ячейки. Это можно обойти при желании.

---

Приложение:

Если вы также хотите иметь кнопку "Назад" для циклического перемещения назад, она становится немного хитрее - вам нужна обобщенная подпрограмма «Предыдущий / следующий» с параметром для определения направления. Затем каждая кнопка должна быть назначена отдельным подпрограммам, которые вызывают основную подпрограмму с соответствующим аргументом:

'============================================================================================
' Module     : <any non-class module>
' Version    : 0.2.0
' Part       : 1 of 1
' References : N/A
' Source     : https://superuser.com/a/1331173/763880
'============================================================================================
Option Explicit

Private Sub Next_or_Previous( _
                                       ByRef direction As Long _
                            )
        Dim plngDirection As Long: plngDirection = direction

  Const s_DestSheet As String = "Sheet1"
  Const s_DestRange As String = "B5"
  Const s_SrcSheet As String = "Sheet2"
  Const s_SrcCell As String = "A1:A10"

  Static sidxCurrentCell As Variant: If IsEmpty(sidxCurrentCell) Then sidxCurrentCell = -plngDirection

  With Worksheets(s_SrcSheet).Range(s_SrcCell)
    sidxCurrentCell = (sidxCurrentCell + plngDirection + .Cells.Count) Mod .Cells.Count
    .Cells(sidxCurrentCell + 1).Copy Destination:=Worksheets(s_DestSheet).Range(s_DestRange)
  End With

End Sub

Public Sub Previous_Click()
  Next_or_Previous -1
End Sub

Public Sub Next_Click()
  Next_or_Previous 1
End Sub

Answer 3

Мой подход совсем другой, чтобы решить проблему.

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

Изменение выбора рабочего листа почти работает как нажатие кнопки, поскольку для 10 элементов требуется 10 щелчков, а для события изменения выбора также требуются аналогичные щелчки, и лучшая часть - это порядок, это может быть восходящий / нисходящий или даже случайный выбор .

Приведенный ниже код скопирует ячейки из указанного диапазона данных A1:A10 при щелчке мыши в ячейку листа листа.

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Not Intersect(Target, Range("A1:A10")) Is Nothing Then
    With Sheets("Sheet2")
        .Select
        .Range("B5").Value = Target.Value
    End With
End If
End Sub

Как работает макрос:

• Щелкните любую ячейку между A1:A10 на исходном листе, чтобы скопировать ее в ячейку целевого листа B5 .

Примечание. Диапазон источника A1:A10 , имя листа назначения, Sheet2 и ячейка B5 , доступны для редактирования.