根据用户输入动态更改单元格中的数字

时间:2016-04-05 17:57:54

标签: excel vba excel-vba

我在列a下面有一个excel表格,我说有10个值 单元格A1 = 1,单元格A2 = 2,单元格A3 = 3 ......单元格A10 = 10 现在假设用户更改了单元格A3中的值。说单元格A3 = 1 所以现在所有其他值都应该动态变化 说A1将变为2,A2将变为3,A3已经为1,A4将变为4等等...... 同样,如果任何其他值发生变化,则应动态排列其余值。仅保留唯一的10个值。不应重复任何价值观。

我已尝试通过复制值来实现此目的但无法这样做。 enter image description here

2 个答案:

答案 0 :(得分:1)

为工作表尝试此更改事件...

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim myVal As Variant
    Dim iCount As Long

    Dim cell As Range
    Dim myRange As Range

    Set myRange = Worksheets("Sheet1").Range("A1:A10")

    If Intersect(Target, Range("A1:A10")) Is Nothing Or Target.Cells.Count > 1 Then Exit Sub
    Application.EnableEvents = False

    myVal = Target.Value
    iCount = 1
    For Each cell In myRange
        If Intersect(Target, cell) Is Nothing Then
            If iCount = myVal Then
                iCount = iCount + 1
            End If
            cell.Value = iCount
            iCount = iCount + 1
        End If
    Next cell


    Application.EnableEvents = True

End Sub

...因为你要求修改。这使用" a _"在数字前面显示它是自动生成的" u _"显示它的用户生成。

Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)

    Dim myVal As Variant
    Dim iCount As Long
    Dim usedString As String
    Dim BypassChange As Boolean

    Dim cell As Range
    Dim myRange As Range

' if the changed range is not of interest, bail out
    If Intersect(Target, Range("A1:A10")) Is Nothing Or Target.Cells.Count > 1 Then Exit Sub

' get setup for the work
    Set myRange = Worksheets("Sheet1").Range("A1:A10")

' usedString will be used to determine if a number has already be set by the user
    usedString = " "
    For Each cell In myRange
        If Left(cell.Value, 2) = "u_" Then
            usedString = usedString & "-" & Right(cell.Value, Len(cell.Value) - 2) & "-"
        End If
    Next cell

' check to make sure the user hasn't specified the same number twice. If he has
' BypassChange will make sure the change gets removed later.
    myVal = Target.Value
    If InStr(usedString, "-" & myVal & "-") > 0 Then
        MsgBox "Value already specified -> " & myVal
        BypassChange = True
    End If

' here's the work
    Application.EnableEvents = False

    iCount = 1
    For Each cell In myRange
        If Intersect(Target, cell) Is Nothing Or BypassChange Then
            If Left(cell.Value, 2) <> "u_" Then
                If iCount = myVal Then
                    iCount = iCount + 1
                End If
                Do While InStr(usedString, "-" & iCount & "-") > 0
                    iCount = iCount + 1
                Loop
                cell.Value = "a_" & iCount
                iCount = iCount + 1
            End If
        Else
            cell.Value = "u_" & myVal
            usedString = usedString & "-" & Right(cell.Value, Len(cell.Value) - 2) & "-"
        End If
    Next cell

    Application.EnableEvents = True

End Sub

答案 1 :(得分:0)

您可以执行一个公式,说明从下一个添加1

A1=1
A2="=A1+1"
A3="=A2+1"
A4="=A3+1"
A5="=A4+1"
A6="=A5+1"

enter image description here

如果您复制并粘贴,则应自动更改

我不能正确理解你的问题吗?