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