Question

我正在尝试交换两个范围。我已经尝试过another post on stack中显示的方法，但仍然无法执行。我也收到诸如此类的错误。此代码“什么也没有发生”：

（这些是大代码示例，但是交换部分的末尾很小。我在注释中指出了它的位置。在开头定义了Temp变量）

或execution error '5' : Argument or procedure call incorrect（出现在我的交换过程的第一行），其代码如下：

Dim X, Y, Xi, Yi, Ligne As Integer
Dim Temp As Range              ''Here is a change I make
For iLine = 3 To LastLine
    If .Cells(iLine, 5) = "Line" Then
        Y = .Cells(iLine, 8).Value
        X = .Cells(iLine, 7).Value
    ElseIf .Cells(iLine, 5) = "Arc" Then
        X = .Cells(iLine, 15).Value
        Y = .Cells(iLine, 16).Value
    End If

    Ligne = iLine + 1
    Do While Ligne <= LastLine
        If .Cells(Ligne, 5) = "Line" Then
            Xi = .Cells(Ligne, 9).Value
            Yi = .Cells(Ligne, 10).Value
        ElseIf .Cells(Ligne, 5) = "Arc" Then
            Xi = .Cells(Ligne, 17).Value
            Yi = .Cells(Ligne, 18).Value
        End If
   '''''Swapping is here
        If (X = Xi) And (Y = Yi) Then 
            Range(.Cells(Ligne, 6), .Cells(Ligne, 18)).Copy Temp               ''Here is a change I make and where the error occurs
            Range(.Cells(iLine + 1, 6), .Cells(iLine + 1, 18)).Copy Range(.Cells(Ligne, 6), .Cells(Ligne, 18))
            Range(.Cells(iLine + 1, 6), .Cells(iLine + 1, 18)) = Temp
            Exit Do
        Else
            Ligne = Ligne + 1
        End If
    Loop
Next iLine

P.S：说明我在做什么：我正在尝试重新整理我的工作表。该工作表包含进出坐标，但这些坐标当前不相互遵循。

因此，我正在比较输入和输出条目，以便以每个输出坐标与下一个条目相同的方式重新组织它们。

这是我的数据：

编辑：

我现在被困在这里。 @ashleedawg发布的功能会清空我的单元格。因此，我尝试实现她的方法，但直接将其实现到我自己的代码中。但是这次回到第一次失败，它什么也没做。我认为这可能是由于代码的另一部分所致，所以如果您发现任何错误，请告诉我：

Dim X, Y, Xi, Yi As Double
Dim Ligne As Integer
Dim Temp, rg1, rg2 As Range
For iLine = 3 To LastLine
    If .Cells(iLine, 5) = "Line" Then
        X = .Cells(iLine, 9).Value
        Y = .Cells(iLine, 10).Value
    ElseIf .Cells(iLine, 5) = "Arc" Then
        X = .Cells(iLine, 17).Value
        Y = .Cells(iLine, 18).Value
    End If

    Ligne = iLine + 1
    Do While Ligne <= LastLine
        If .Cells(Ligne, 5) = "Line" Then
            Xi = .Cells(Ligne, 7).Value
            Yi = .Cells(Ligne, 8).Value
        ElseIf .Cells(Ligne, 5) = "Arc" Then
            Xi = .Cells(Ligne, 15).Value
            Yi = .Cells(Ligne, 16).Value
        End If

        If (Xi = X) And (Yi = Y) Then
            Set Temp = Range(.Cells(1000, 1000), .Cells(1000, 1012))
            Set rg1 = Range(.Cells(Ligne, 6), .Cells(Ligne, 18))
            Set rg2 = Range(.Cells(iLine + 1, 6), .Cells(iLine + 1, 18))
            rg1.Copy Temp
            rg2.Copy rg1
            Temp.Copy rg2
            'SwapRanges Range(.Cells(iLine + 1, 6), .Cells(iLine + 1, 18)), Range(.Cells(Ligne, 6), .Cells(Ligne, 18))
            Exit Do
        Else
            Ligne = Ligne + 1
        End If
    Loop
Next iLine

我在温度范围内的最后一项是工作表的最后一行：

Arc 50  120         50  46,834  180 5   84,206  156,469 0   120

Answer 1

Sub SwapRanges将交换您为其指定的两个单元格范围。

它没有错误处理（尚未），主要是确保范围的大小和形状相同（行x列），但我可以在后面添加。从理论上讲，还可以添加功能以提示您选择（突出显示）第一个范围，然后选择第二个范围的开头。或者，如果范围总是相同，则可以将子项更改为仅指定开始单元格和结束单元格...

但是现在：

Sub SwapRanges(rg1 As Range, rg2 As Range)
    Const SwapRC = 1000 ' unused cells to temporaily house the data. (row 1000, col 1000)
    Dim rgLimbo As Range

    Set rgLimbo = Range(Cells(SwapRC, SwapRC), Cells(SwapRC + rg1.Rows.Count, SwapRC + rg1.Columns.Count))
    rg1.Copy rgLimbo       'copy rg1 to "limbo"
    rg2.Copy rg1           'copy rg2 to rg1
    rgLimbo.Copy rg2       'copy "limbo" to rg1
    rgLimbo.ClearContents  'clear "limbo"
End Sub

...例如，我最终在这两个范围内对其进行了测试，并且包括单元格格式在内的所有内容都反复地来回交换。

Sub Example()
    SwapRanges Range("B2:D8"), Range("F6:H9")
End Sub

它使用“ limbo”单元格位置作为临时“持有人”，从行1000第1000列开始。如果那里已有数据，则需要更改常数。

这是它为我工作的一个示例...（我刚刚将Example分配给了按钮。）

Answer 2

更改此行后对我有用

Set rgLimbo = Range(Cells(SwapRC, SwapRC), Cells(SwapRC + rg1.Rows.Count, SwapRC + rg1.Columns.Count))

对此

Set rgLimbo = Range(Cells(SwapRC, SwapRC), Cells(SwapRC + rg1.Rows.Count-1, SwapRC + rg1.Columns.Count-1))

交换两个范围的VBA

2 个答案: