獲取數字以便在插入行時自動向上移動

Question

當前正在使用Excel工作表對項目進行排名，如果插入新行並輸入現有數量級別，我們希望它自動增加數字。如果我們輸入一行並在9中輸入它的等級，我們希望現有的9移動到10，舊的10移動到11等等。我有一種解決方法，但是我的代碼自動將第一行編號爲1等等。這是我迄今爲止所擁有的。

Private Sub Worksheet_Change(ByVal Target As Range) 
    Dim I As Integer 
    I = 1 
    Application.EnableEvents = False 
    For I = 1 To 20 
     Range("A" & I).Value = I 
    Next 
    Range("A21").Value = "" 
    Application.EnableEvents = True 
End Sub 

Answer 1

你可以遍歷列中的每一個細胞，如果其值大於（或等於）一個剛剛改變，由一個增加它：

Private Sub Worksheet_Change(ByVal Target As Range) 
    Dim I As Long 
    Dim v As Long 
    Dim r As Range 
    Set r = Application.Intersect(Range("A:A"), Target) 
    If r Is Nothing Then 
     Exit Sub 
    End If 
    If r.Count > 1 Then 
     Exit Sub 
    End If 
    If IsEmpty(r.Value) Then 
     Exit Sub 
    End If 
    I = 1 
    v = r.Value 
    If Application.CountIf(Range("A:A"), v) > 1 Then ' Only change things if this 
                ' value exists elsewhere 
     Application.EnableEvents = False 
     For I = 1 To Cells(Rows.Count, "A").End(xlUp).Row 
      If Cells(I, "A").Address <> r.Address Then 
       If IsNumeric(Cells(I, "A").Value) Then ' skip cells that aren't numeric 
        If Cells(I, "A").Value >= v Then 
         Cells(I, "A").Value = Cells(I, "A").Value + 1 
        End If 
       End If 
      End If 
     Next 
     Application.EnableEvents = True 
    End If 
End Sub