Question

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

此计划发生变化，因此彩色条需要手动向右或向左调整。我可能误导你提出我的想法，但无论如何都可能有用。我以为我制作了一个额外的列来计算月份的差异（这很简单）。例如，如果我们有一个数字为6的列，并且计划向左移动（重新安排），则数字6将减少，因此根据此减少，我想链接彩色条以自动移动到因此，左（这就是我称之为步骤）。如果延长截止日期，则将彩色条向右移动。

我已经实现了一个带有弹出日历的简单宏，用于以更专业的方式获取日期（对不起我的基本VBA技能），所以剩下的（复杂的部分）就剩下了。：）

P.S。我真的没有经验，只能设法得到以下内容，根据数字的变化将细胞向右移动，但没有步骤，没有双向移动，真的很复杂，担心这是不可能的。

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

照片：

PICTURE ATTACHED HERE

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

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

2 个答案:

编辑：