excel vba arr Intelligent judgment cycle-CodePudding

picture

Column a is copied to column b, and the last cell is transformed

Column b copies column c (analogy), and the cell transformation decreases to the second row for incremental transformation (wavy, the first row does not participate in the transformation)

Special treatment until the last column no longer meets the transformation conditions (w1 unchanged, w2:w6 transformed). The data will only have 1 and 0, the number of input rows in the first column is not limited, I hope the font color and background color will be preserved after transformation

Brief description: 0 becomes 1, 1 becomes 0. The first row remains unchanged, and the next column is copied from the previous column, The transformation decreases or increases according to the transformation position in the previous column, The first round transforms one cell, and the nth round transforms n cells simultaneously

CodePudding user response：

Public Sub trans()

    Dim w As Range
    Set w = ActiveSheet.Cells()

    topRow = 6
    bottomRow = 6
    Height = 1
    Direction = -1
    curColumn = 2
    
    Range(w(1, 1), w(6, 1)).Value = 1
    
    While topRow <> 1
        Range(w(1, curColumn - 1), w(6, curColumn - 1)).Copy
        w(1, curColumn).PasteSpecial Paste:=xlPasteValues
        For curRow = topRow To bottomRow
            w(curRow, curColumn).Value = Abs(w(curRow, curColumn) - 1)
        Next curRow
        Range(w(topRow, curColumn), w(bottomRow, curColumn)).Select
        Selection.Font.Color = -16776961
        
        With Selection.Interior
            Rem .PatternColorIndex = xlAutomatic
            .ThemeColor = xlThemeColorDark2
            .TintAndShade = -9.99786370433668E-02
        End With
        
        curColumn = curColumn   1
        If topRow = 2 And Direction = -1 Or bottomRow = 6 And Direction = 1 Then
            Direction = Direction * -1
            If Direction = -1 And bottomRow = 6 Then
                Height = Height   1
                topRow = topRow - 1
            End If
        End If
        topRow = topRow   Direction
        bottomRow = topRow   Height - 1
    Wend
End Sub