Excel VBA:水平翻转单元格及其格式

Excel VBA:水平翻转单元格及其格式

我正在尝试编写一个代码,它将通过 Virtual Basic 水平翻转我的单元格以及单元格格式(我也需要背景颜色来翻转)。

我所说的翻转是这样的:

图形解释

我提供了实际翻转单元格值的代码,但并未移动所有格式。是否可以翻转背景?

我的代码是:

Sub Fliphorizontally()
'updateby Extendoffice
Dim Rng As Range
Dim WorkRng As Range
Dim Arr As Variant
Dim i As Integer, j As Integer, k As Integer
On Error Resume Next
xTitleId = "KutoolsforExcel"
Set WorkRng = Application.Selection
Set WorkRng = Application.InputBox("Range", xTitleId, WorkRng.Address, Type:=8)
Arr = WorkRng.Formula
For i = 1 To UBound(Arr, 1)
    k = UBound(Arr, 2)
    For j = 1 To UBound(Arr, 2) / 2
        xTemp = Arr(i, j)
        Arr(i, j) = Arr(i, k)
        Arr(i, k) = xTemp
        k = k - 1
    Next
Next
WorkRng.Formula = Arr
End Sub

如果这有区别的话——我用的是 Mac,而不是 PC

答案1

试试这个代码:

Public Sub Test()

    Dim SourceRange As Range
    Set SourceRange = Sheet1.Range("C2:F2") 'Your original data.
    
    Dim Target As Range
    Set Target = Sheet1.Range("C3") 'First cell of the reversed data.
    
    Target.Resize(, SourceRange.Columns.Count) = ReverseRange(SourceRange)
    
    Dim ColourRef As Variant
    ColourRef = ReverseRange(SourceRange, True)
    Dim Ref As Variant
    Dim Cntr As Long
    For Each Ref In ColourRef
        Target.Offset(, Cntr).Interior.Color = Ref
        Cntr = Cntr + 1
    Next Ref

End Sub

 
Public Function ReverseRange(Source As Range, Optional ReverseColour As Boolean = False) As Variant

    Dim Cell As Range
    With CreateObject("System.Collections.ArrayList")
        For Each Cell In Source
            .Add IIf(ReverseColour, Cell.Interior.Color, Cell.Value2)
        Next Cell
        .Reverse
        ReverseRange = .ToArray
    End With

End Function

相关内容