如何在使用Worksheet_Change事件时防止Excel中的单元格移动

Question

>我有这段代码，它工作得很好。 唯一的问题是，例如，在单元格"A2"中按 Enter 后，而不是像往常那样向下移动到单元格"A3"——它移动到单元格"E3"，因此用户很难输入。

有什么建议吗？

Private Sub Worksheet_change(ByVal Target As Range)
Application.EnableEvents = False
Range("A2:M2").Interior.ColorIndex = 19
Dim LASTROW As Long
TheLastRow = ActiveSheet.UsedRange.SpecialCells(xlCellTypeLastCell).Row
Dim intx As Variant
For i = 2 To TheLastRow
If Range("a" & i) = Range("a" & i + 1) Then
Range("A" & i + 1 & ":n" & i + 1).Interior.Color = Range("a" & i).Interior.Color
intx = intx + 0
Else
Range("A" & i + 1 & ":n" & i + 1).Interior.ColorIndex = 46 - intx
intx = intx + 1
End If
Next i
For i = 2 To TheLastRow
Range("e" & i).Select
ActiveCell.FormulaR1C1 = _
"=IF(ISBLANK(RC[-1]),"""",HYPERLINK(""PCDOCS://PCDOCS_JLM/""&RC[-1]&""/R"",""link""))"
Next i
Application.EnableEvents = True
End Sub       

Answer 1

您应该避免在 VBA 中使用 SELECT 或 ACTIVATE ，因此：

Private Sub Worksheet_change(ByVal Target As Range)
Application.EnableEvents = False
Range("A2:M2").Interior.ColorIndex = 19
Dim LASTROW As Long
TheLastRow = ActiveSheet.UsedRange.SpecialCells(xlCellTypeLastCell).Row
Dim intx As Variant
For i = 2 To TheLastRow
If Range("a" & i) = Range("a" & i + 1) Then
Range("A" & i + 1 & ":n" & i + 1).Interior.Color = Range("a" & i).Interior.Color
intx = intx + 0
Else
Range("A" & i + 1 & ":n" & i + 1).Interior.ColorIndex = 46 - intx
intx = intx + 1
End If
Next i
For i = 2 To TheLastRow
Range("e" & i).FormulaR1C1 = _
"=IF(ISBLANK(RC[-1]),"""",HYPERLINK(""PCDOCS://PCDOCS_JLM/""&RC[-1]&""/R"",""link""))"
Next i
Application.EnableEvents = True
End Sub    

Answer 2

我对你的代码做了一些修改，当我在单元格"A2"上按{enter}时，它会执行代码并"跳转"到单元格"A3"。

法典

Option Explicit
Private Sub Worksheet_change(ByVal Target As Range)
Dim C As Range
Dim intx As Long
Application.EnableEvents = False
Range("A2:M2").Interior.ColorIndex = 19
' loop through all cells with data in column "A"
For Each C In Range("A2:A" & Cells(Rows.Count, "A").End(xlUp).Row)
If C.Value = C.Offset(1, 0).Value Then
C.Offset(1, 0).Resize(1, 14).Interior.Color = C.Interior.Color
Else
C.Offset(1, 0).Resize(1, 14).Interior.Color = 46 - intx
intx = intx + 1
End If
Next C
' loop through all cells with data in column "E"
For Each C In Range("E2:E" & Cells(Rows.Count, "E").End(xlUp).Row)
C.FormulaR1C1 = "=IF(ISBLANK(RC[-1]),"""",HYPERLINK(""PCDOCS://PCDOCS_JLM/""&RC[-1]&""/R"",""link""))"
Next C
Application.EnableEvents = True
End Sub

Answer 3

您可以从提示事件的单元格中读出地址并保存它们。 代码完成后，您可以选择下面的 1 行单元格。 希望这有帮助。

私人子Worksheet_change(按价值目标范围(

Application.EnableEvents = False

Dim rngAddress As String
rngAddress  = Target.Address
Range("A2:M2").Interior.ColorIndex = 19
Dim LASTROW As Long
TheLastRow = ActiveSheet.UsedRange.SpecialCells(xlCellTypeLastCell).Row
Dim intx As Variant
For i = 2 To TheLastRow
If Range("a" & i) = Range("a" & i + 1) Then
Range("A" & i + 1 & ":n" & i + 1).Interior.Color = Range("a" & i).Interior.Color
intx = intx + 0
Else
Range("A" & i + 1 & ":n" & i + 1).Interior.ColorIndex = 46 - intx
intx = intx + 1
End If
Next i
For i = 2 To TheLastRow
Range("e" & i).Select
ActiveCell.FormulaR1C1 = _
"=IF(ISBLANK(RC[-1]),"""",HYPERLINK(""PCDOCS://PCDOCS_JLM/""&RC[-1]&""/R"",""link""))"
Next i
Range(rngAddress).offset(1,0).select
Application.EnableEvents = True
End Sub