Wie verhindert man die Verschiebung von Zellen in Excel bei Verwendung von Worksheet_Change Event

Question

Ich habe diesen Code und es funktioniert gut. Das einzige Problem ist, dass, nachdem ich Enter, in der Zelle "A2" zum Beispiel, anstatt hinunter zu Zelle "A3", wie es normalerweise würde - es bewegt sich in Zelle "E3", so dass es schwierig für den Benutzer zu machen Art.

Irgendwelche Vorschläge?

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

Sie sollten mit SELECT oder ACTIVATE in VBA vermeiden, so:

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

Ich habe einige Änderungen an Ihrem Code, und wenn ich {enter} auf Zelle „A2“ drücken führt es den Code und „springt“ „A3“ Zelle.

-Code

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

Sie können die Adresse aus der Zelle auslesen, die das Ereignis Trigert und sparen Sie. Nachdem Ihr Code fertig ist, können Sie die Zelle, 1 Zeile darunter auswählen. Hoffe, dass dies hilft.

Private Sub Worksheet_Change (ByVal Ziel als Strecke)

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