英文:
Auto change number in a column when duplicate number entered
问题
我正在尝试使列号在同一列再次输入相同数字时自动减1。
基本上，我正在对列表进行排序，从1到任意数字，然后自动排序并更改该新数字下方的所有内容以减1。我已经编写了用于自动排序的VBA代码，但数字的更改让我困惑不已。
起始点：
如果我将D9更改为5，我需要它移动到该位置（D6）并将D7:D11减1。
我已经有用于排序的VBA代码：
Private Sub Worksheet_Change(ByVal Target As Range)
On Error Resume Next
If Not Intersect(Target, Range("A:d")) Is Nothing Then
Range("D1").Sort Key1:=Range("D2"), _
Order1:=xlAscending, Header:=xlYes, _
OrderCustom:=1, MatchCase:=False, _
Orientation:=xlTopToBottom
End If
End Sub
但我真的需要帮助处理另一部分。
英文:
I am try to get a column number to change automatically, by -1, if the same number is entered in the same column again.
Basically I am sorting a list 1 to whatever and then auto sort and change everything below that new number to change by -1. I have the VBA to auto sort as I go but the change in number has me stumped.
Starting point:
If I change D9 to 5 I need it to move into that position (D6) and change D7:D11 by -1
I already have the VBA for the sorting:
Private Sub Worksheet_Change(ByVal Target As Range)
On Error Resume Next
If Not Intersect(Target, Range("A:d")) Is Nothing Then
Range("D1").Sort Key1:=Range("D2"), _
Order1:=xlAscending, Header:=xlYes, _
OrderCustom:=1, MatchCase:=False, _
Orientation:=xlTopToBottom
End If
End Sub
but really need help with the other.
答案1
得分: 2
您所询问的内容将在列D中的单元格的值更改为大于其当前值时起作用。如果将其更改为小于其当前值的值，则不起作用。
以下是适用于两种情况的解决方案：
注意：这假设列D从1开始按顺序编号并排序。如果不是这样，您可能会得到奇怪的结果。
Private Sub Worksheet_Change(ByVal Target As Range)
Dim TargetRow As Long, i As Long, lr As Long
If Target.CountLarge > 1 Then Exit Sub
If Not Intersect(Target, Range("D:D")) Is Nothing Then
On Error GoTo EH
TargetRow = Target.Row
Application.EnableEvents = False
lr = Me.Cells(Me.Rows.Count, 4).End(xlUp).Row
If Target.Value2 >= TargetRow Then
If Target.Value2 >= lr Then Target.Value2 = lr - 1
For i = TargetRow + 1 To Target.Value2 + 1
Me.Cells(i, 4).Value2 = Me.Cells(i, 4).Value2 - 1
Next
ElseIf Target.Value2 < TargetRow - 1 Then
If Target.Value2 <= 0 Then Target.Value2 = 1
For i = Target.Value2 + 1 To TargetRow - 1
Me.Cells(i, 4).Value2 = Me.Cells(i, 4).Value2 + 1
Next
End If
Me.Range("A1:D" & lr).Sort Key1:=Me.Range("D2"), _
Order1:=xlAscending, Header:=xlYes, _
OrderCustom:=1, _
MatchCase:=False, _
Orientation:=xlTopToBottom
End If
EH:
Application.EnableEvents = True
End Sub
英文:
What you are asking for will work if a cell in column D is changed to a value greater than its current value. It won't work if its changed to a value less than its current value.
Here's a solution that works for both
Note: this assumes column D starts out numbered sequentialy from 1 and sorted. If not, you'll get weird results.
Private Sub Worksheet_Change(ByVal Target As Range)
Dim TargetRow As Long, i As Long, lr As Long
If Target.CountLarge > 1 Then Exit Sub
If Not Intersect(Target, Range("d:d")) Is Nothing Then
On Error GoTo EH
TargetRow = Target.Row
Application.EnableEvents = False
lr = Me.Cells(Me.Rows.Count, 4).End(xlUp).Row
If Target.Value2 >= TargetRow Then
If Target.Value2 >= lr Then Target.Value2 = lr - 1
For i = TargetRow + 1 To Target.Value2 + 1
Me.Cells(i, 4).Value2 = Me.Cells(i, 4).Value2 - 1
Next
ElseIf Target.Value2 < TargetRow - 1 Then
If Target.Value2 <= 0 Then Target.Value2 = 1
For i = Target.Value2 + 1 To TargetRow - 1
Me.Cells(i, 4).Value2 = Me.Cells(i, 4).Value2 + 1
Next
End If
Me.Range("A1:D" & lr).Sort Key1:=Me.Range("D2"), _
Order1:=xlAscending, Header:=xlYes, _
OrderCustom:=1, _
MatchCase:=False, _
Orientation:=xlTopToBottom
End If
EH:
Application.EnableEvents = True
End Sub
通过集体智慧和协作来改善编程学习和解决问题的方式。致力于成为全球开发者共同参与的知识库，让每个人都能够通过互相帮助和分享经验来进步。
评论