Изменение рабочего листа VBA

Question

Я работаю с Worksheet_Change VBA-кодом в Excel, как показано ниже.

Private Sub Worksheet_Change(ByVal Target As Range)

If Not Intersect(Target, Range("A2:A2000")) Is Nothing Then

Call writetag

End If

End Sub

Sub writetag()

    ActiveCell.Select
    ActiveCell.Offset(0, 1).Select
    ActiveCell.Formula = "1st Request"

End Sub

Один только writetag VBA-код отлично справляется со своей задачей: он перемещает одну ячейку вправо активной ячейки и напишите «1-й запрос». Затем у меня есть первый код VBA - Worksheet_Change - который будет запускать код writetag всякий раз, когда в диапазон A2: A2000 вносятся изменения. Но именно в этой части код writetag не работает идеально. Вместо того, чтобы перемещать 1 ячейку вправо, она переместит 1 ячейку вправо и еще 1 ячейку внизу. Поэтому мне нужно настроить ActiveCell.Offset(0, 1).Select на ActiveCell.Offset(-1, 1).Select только для того, чтобы он переместился в правую ячейку. Затем, после этого, я хотел бы сделать 3 условия или Ifs, при которых, когда я ставлю 1 в любом месте диапазона A2: A2000, он будет ставить «1-й запрос» справа от него. Если я поставлю 2 в любом месте диапазона, справа будет «2-й запрос», «3-й запрос», если я поставлю 3.

Большое спасибо за помощь.

Answer 1

Помните, что target - это адрес вызываемой ячейки, в вашем случае предположим, что вы ввели в ячейку A1:

target = [A1], но проблема в том, что это событие возникает после изменения значения, поэтому после нажатия enter ActiveCell = [A2], затем вызывается событие и получается результат

ActiveCell.offset (0,1) = [A2] .offset (0,1) = [B2]

, поэтому ваш код не работает, давайте попробуем:

Private Sub Worksheet_Change(ByVal Target As Range)
    If Not Intersect(Target, Range("A2:A2000")) Is Nothing Then
        Call writetag(Target)
    End If
End Sub
Sub writetag(rng As Range)
    With rng.Offset(0, 1)
        Select Case rng.Value2
            Case 1
                .Formula = "1st Request"
            Case 2
                .Formula = "2nd Request"
            Case 3
                .Formula = "3rd Request"
        End Select
    End With
End Sub

Answer 2

Используйте следующую подпрограмму при вводе значения и нажатии ENTER на клавиатуре.

Private Sub Worksheet_Change(ByVal Target As Range)
    If Not Intersect(Target, Range("A2:A2000")) Is Nothing Then
        Call writetag
    End If
End Sub

---

Sub writetag()
Dim curr As Variant
    curr = ActiveCell.Offset(-1, 0)
    ActiveCell.Offset(-1, 1) = curr & "st Request"

End Sub