使用Excel Macro / VBA使用值列表创建循环

时间:2018-12-04 16:47:25

标签: excel vba loops

我在单元格A1:A10中有一个值列表。

我想创建一个宏,以便单元格B1将首先在列表中包含第一个值,然后用第二个值替换它,然后是第三个,依此类推。一旦整个列表运行完毕,它应该再次循环回到第一个值。相同的顺序/顺序应贯穿始终。

如果它影响任何代码,那么我可能最终会使用一个按钮来运行此代码,以便每次按下该按钮时,列表上的下一项将接管单元格B1。

是否可以输入任何代码来帮助启动循环?当我全部运行宏时,我会反复获得相同的值。

感谢您的帮助!

编辑:这是我最近的尝试之一:

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 :(得分:0)

根据您的描述和提供的代码,看起来这就是您想要的:

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