简体   繁体   中英

excel vba cell value step loop

Multiple cells reference cell R1 for an indirect lookup to one of four other sheets. The sheets are named week1, week2, week3, and week4. What I am looking to do, is when I click Button X, my reference cell changes from week1 to week2. and every time I click it should advance to the extent that week4 leads back to week1.

My current broken code reads:

  'Change the week number in cell R1
week = Range("R1")
If week = week1 Then
    Range("R1").Value = week2
Else
    If week = week2 Then
        Range("R1").Value = week3
    Else
        If week = week3 Then
            Range("R1").Value = week4
        Else
            If week = week4 Then
                Range("R1").Value = week1
            End If
        End If
    End If
End If
Application.ScreenUpdating = True 'Turns viewing function back on so the spreadsheet is usable.
End Sub
Select Case week
    Case Is = week1: vValue = week2
    Case Is = week2: vValue = week3
    Case Is = week3: vValue = week4
    Case Is = week4: vValue = week1
End Select

Range("R1").Value = vValue
Application.ScreenUpdating = True

You should be able to do this in a single code line.

Range("R1") = Format(InStr(1, "4123", Right(Range("R1").Value, 1)), "\W\e\ek0")

This will cycle through Week1, Week2, Week3, Week4, Week1, ... . I've omitted the parent worksheet reference of R1 but it is never a bad idea to include that.

There is a simple way to solve it:

Range("R1") = Left(Range("R1"), 4) & Right(Range("R1"), 1) Mod 4 + 1
'number after Mod = max week

Mod x just sets the count to 0 if it is at its max (the + 1 sets it then to 1 again) However, you may use this sub to avoid strange behavior:

Sub NewWeekMax()
  Dim str As String, i As Byte
  str = "Week1"
  For i = 2 To 4 'last num = max weeks
    str = str & ",week" & i
  Next
  With Range("R4").Validation
    .Delete
    .Add 3, 1, 1, str
    .InCellDropdown = True
    .ShowInput = True
    .ShowError = True
  End With
End Sub

This sub simply sets a data validation to disable wrong input in R1

The technical post webpages of this site follow the CC BY-SA 4.0 protocol. If you need to reprint, please indicate the site URL or the original address.Any question please contact:yoyou2525@163.com.

 
粤ICP备18138465号  © 2020-2024 STACKOOM.COM