Excel VBA:如何在同一列中交换两个选定的单元格范围(不仅仅是两个值)?

时间:2018-05-03 09:30:13

标签: excel excel-vba range cell swap vba

我想在同一列中交换选定的单元格区域而不自动调整其他列中的附加公式。那些细胞范围几乎总是不等的。

我找到了一个VBA代码,可以为两个选定的单元格执行此操作,但我担心这对我没有多大帮助。

Sub SwapCells()
    Dim sHolder As String

    If Selection.Cells.Count = 2 Then
        With Selection
            sHolder = .Cells(1).Formula
            If .Areas.Count = 2 Then  ' Cells selected using Ctrl key
                .Areas(1).Formula = .Areas(2).Formula
                .Areas(2).Formula = sHolder
            Else                      ' Adjacent cells are selected
                .Cells(1).Formula = .Cells(2).Formula
                .Cells(2).Formula = sHolder
            End If
        End With
    Else
        MsgBox "Select only TWO cells to swap", vbCritical
    End If
End Sub

我知道另一种选择是在移动细胞范围时保持'移位'(完美地工作),但随后所有附加的公式将改变我不想要的参考(例如,如果我有一个指代细胞的公式) A1,并且我在某处交换A1,公式将引用A1的新位置,但我希望公式仍然引用A1)。

我认为另一个选择是使用INDIRECT(“G”和ROW())来修复它,但由于它是一个资源密集型公式,我喜欢看到另一种选择。

最重要的是,后两个选项不允许我使用表格(由于其他原因,我更喜欢这个表格),因为你无法在表格中交换单元格。这就是为什么Id非常喜欢VBA选项。

希望你能帮帮我,谢谢!也许只需要稍微调整一下VBA代码。

亲切的问候, 马可

编辑:如果交换两个相等的细胞范围(例如每个包含5个细胞)要容易得多,那么这也是一个很好的解决方案。

1 个答案:

答案 0 :(得分:0)

Sub SwapTwoSelectedRanges()

    Dim initialRng As Range
    Set initialRng = Selection

    If initialRng.Areas.Count <> 2 Then
        Debug.Print "Select 2 areas!"
        Exit Sub
    End If

    If initialRng.Areas(1).Cells.Count <> initialRng.Areas(2).Cells.Count Then
        Debug.Print "The cells should be the same number!"
        Exit Sub
    End If

    Dim intermediateRng As Variant
    intermediateRng = initialRng.Areas(1).Cells.Value2

    initialRng.Areas(1).Cells.Value2 = initialRng.Areas(2).Cells.Value2
    initialRng.Areas(2).Cells.Value2 = intermediateRng

End Sub

如果使用中间值,则交换两个值被视为一项简单的任务。对于范围,在交换范围之前要执行两项重要检查:

  1. 所选区域是否正好为2;
  2. 每个区域的单元格数量是否相等;
  3. 然后使用intermediateRng作为3.变量,进行交换;
  4. 如果区域是每列,这只会起作用。如果每行进行选择,则结果将不符合预期;
  5. 关于颜色的交换,如果每个区域的所有单元格的颜色完全相同,这将有效:

    Dim intermediateRng As Variant
    Dim intermediateClr As Variant
    
    intermediateRng = initialRng.Areas(1).Cells.Value2
    intermediateClr = initialRng.Areas(1).Cells.Interior.Color
    
    With initialRng
        .Areas(1).Cells.Value2 = .Areas(2).Cells.Value2
        .Areas(1).Cells.Interior.Color = .Areas(2).Cells.Interior.Color
    
        .Areas(2).Cells.Value2 = intermediateRng
        .Areas(2).Cells.Interior.Color = intermediateClr
    End With
    

    但是,如果每个区域的单元格颜色不相同,那么最简单的方法是将第一个范围复制+粘贴到一个单独的范围并从那里开始工作。