Excel VBA根据值更改向左或向右移动单元格（步骤）

Question

基本上，这是用于计划的列表。 彩色条是根据计划根据开始日期，结束日期列手动设置的。

该计划会发生变化，因此彩条需要手动向右或向左调整。 我可能会误导您给出我的想法，但是无论如何都无济于事。 我以为我做了一个额外的列来计算月份差异（这很简单）。 例如，如果我们有一个带有数字6的列，并且计划向左移动（重新计划），数字6将会减少，因此根据这个减少，我想链接彩色的条形图以自动移动到左（这就是我所说的步骤）。 如果截止日期已延长，则将彩条移至右侧。

我已经实现了带有弹出日历的简单宏，可以用更专业的方式（特别是我的基本VBA技能）来获取日期，因此剩下的（复杂的部分）就可以了。 :)

ps我真的没有经验，只能设法得到以下结果，它根据数字的变化将细胞向右移动，但是没有台阶，没有两面运动，真的很复杂，担心这是不可能的。

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address = "$A$1" Then
Application.EnableEvents = False
ActiveCell.Insert Shift:=xlToRight
Application.EnableEvents = True
End If
End Sub

图片：

Answer 1

好吧，这是我对问题的解释允许我做的事情：

Option Explicit

' Store the current state of your cell here!
'
' The value defaults to Zero on the first run.
' If you don't like that, you should call a
' function that stores the current value in
' here first...
Dim currentNum As Integer

Private Worksheet_Change(ByVal Target As Range)

    ' Check if  the changed value belonged to
    ' your modifier-cell. If it didn't, exit
    ' the sub. Otherwise continue with your
    ' operation.
    If Not Target.Address = "A1" Then

        Exit Sub

    End If

    ' Use a for-loop to iterate over all the cells
    ' within a specific range.
    Dim c As Integer    ' Holds the current column
    Dim r As Integer    ' Holds the current row
                        '(inside the current column)

    ' Iterate over the columns...
    For c = 0 To <your_range>.Columns.Count

        ' Iterate over all rows in each column...
        For r = 0 To <your_range>.Rows.Count

            If Not IsEmpty(<your_range>.Cells(c,r)) Then

                ' I never know if c or r goes first.
                ' Make sure they're in the right order.

                ' Now, we're checking the current value
                ' of your cell against the nust updated new
                ' value:
                If GetModifierCellValue() > currentNum Then

                    ' The GetModifierCellValue()-Function doesn't exist. I recommend you write one.
                    ' Otherwise you could just query the value with the cell's address...

                    If c+(ABS(currentNum-GetModifierCellValue()) <= <your_range>.Columns.Count Then

                        ' Copy the value to the cell you'd like to shift to
                        <your_range>.Cells(c+(ABS(currentNum-GetModifierCellValue())), r).Value =_
                        <your_range>.Cells(c,r).Value
                        ' Again: maybe it has to be the other way round...

                        ' Empty the current cell
                        <your-range>.Cells(c,r).Value = ""

                    End If

                ElseIf GetModifierCellValue() < currentNum Then

                    If c-(ABS(currentNum-GetModifierCellValue()) >= 1 Then

                        ' Copy the value to the cell you'd like to shift to
                        <your_range>.Cells(c-(ABS(currentNum-GetModifierCellValue())), r).Value =_
                        <your_range>.Cells(c,r).Value
                        ' Again: maybe it has to be the other way round...

                        ' Empty the current cell
                        <your-range>.Cells(c,r).Value = ""

                    End If

                End If

            End If

        Next

    Next

End Sub

注意：您绝对应该阅读我的所有评论。 它们非常重要。 而且，由于您不熟悉（VBA）编程，因此它们实际上可能在以后的编程生涯中对您有很大帮助。

编辑：

使用上面的代码，您将覆盖现有的单元格。 如果您想避免这种情况，请将更改（仅更改！）应用于临时表，然后将该临时表复制到您的真实表中。

同样，您不能将IsEmpty（）用于要实现的目标。 它没有考虑到细胞的背景颜色（我相信...）！ 请改用单元格的背景颜色属性。

Answer 2

正如其他人指出的那样，即使这是一个有趣的问题，您的问题中仍有许多未解决的问题。

我在下面提供了代码，它将为您提供一个良好的工作框架。 您需要对范围引用和某些逻辑进行更改，但是我确实通过您提供的小示例将其组合在一起，只是为了展示其工作方式或工作方式。

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)

'If Target.Address = "$A$1" Then 'will only fire if cell A1 is changed
'If Target.Column = 1 Then 'will only fire if any cell in column A is changed
If Not Intersect(Target, Range("A1:Z10000")) Is Nothing Then 'will only fire if a cell in the A1:Z100000 is changed

    If Target.Cells.Count = 1 Then 'further refine to make sure only one cell changed

        Application.EnableEvents = False

        'first lets get the difference of the old value versus the new value
        Dim iOld As Integer, iNew As Integer, iSize As Integer 'using byte for the assumption that the numbers will always be small
        iNew = Target.Value2
        Application.Undo
        iOld = Target.Value2
        Target.Value = iNew 'reset change back after getting old value

        If iNew - iOld > 0 Then 'check to make sure difference is positive

            iSize = iNew - iOld

            Select Case iSize ' here you can set your conditions based on the difference

                Case Is > 1

                    Target.Resize(1, iSize).Insert shift:=xlToRight

                Case Is = 1

                    With Target

                        If .Column <> 1 Then  'because can't move anything to the left of column A
                            .Cut
                            .Offset(, -1).Insert shift:=xlToRight
                        End If

                    End With

            End Select

        End If

        Application.EnableEvents = True

    End If

End If

End Sub