Создание цикла с использованием списка значений с помощью Excel Macro / VBA - PullRequest
0 голосов
/ 04 декабря 2018

У меня есть список значений в ячейках A1: A10.

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

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

Можно ли ввести какой-либо код, чтобы помочь запустить цикл?Когда я запускаю макрос all, я постоянно получаю одно и то же значение.

Спасибо за любую помощь!

РЕДАКТИРОВАТЬ: Вот одна из моих последних попыток:

Sub macro1()
  Dim LR As Long, i As Long
  With ActiveSheet
    LR = .Range("A1" & Rows.Count).End(xlUp).Row
    For i = 1 To LR
      .Range("A" & i).Copy Destination:=ActiveSheet.Range("B1")
    Next i
  End With
End Sub

1 Ответ

0 голосов
/ 04 декабря 2018

Исходя из вашего описания и предоставленного кода, кажется, что это то, что вы ищете:

Sub btnNext_Click()

    Const sListStartAddr As String = "A1"   'This is the cell address where your list of values to be cycled through starts
    Const sOutputAddr As String = "F3"      'This is the cell address where the current value of the "loop" will be output

    Dim ws As Worksheet
    Dim rList As Range
    Dim rUpdateCell As Range
    Dim rFound As Range

    Set ws = ActiveWorkbook.ActiveSheet
    Set rList = ws.Range(sListStartAddr, ws.Cells(ws.Rows.Count, ws.Range(sListStartAddr).Column).End(xlUp))
    Set rUpdateCell = ws.Range(sOutputAddr)

    If Len(Trim(rUpdateCell.Value)) = 0 Then
        'Update Cell is blank, put first value from list
        rUpdateCell.Value = rList.Cells(1).Value
    Else
        Set rFound = rList.Find(rUpdateCell.Value, rList.Cells(rList.Cells.Count), xlValues, xlWhole)
        If rFound Is Nothing Then
            'Update Cell isn't blank, but its value isn't in the list, replace with first value from list
            rUpdateCell.Value = rList.Cells(1).Value
        Else
            If rFound.Row = rList.Row + rList.Rows.Count - 1 Then
                'Update Cell isn't blank and its value is in the list, but it's the last item in the list, replace with first value from list
                rUpdateCell.Value = rList.Cells(1).Value
            Else
                'Update Cell isn't blank, its value is in the list, and it's not the last item in the list, proceed to next value in the list
                rUpdateCell.Value = rFound.Offset(1).Value
            End If
        End If
    End If

End Sub
Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...