vba - 交换两个范围 VBA

Question

我正在尝试交换两个范围。我试过another post on stack中的方法但我还是做不到。我也收到诸如此类的错误..此代码“没有任何 react ”:

(这些是大代码示例，但最后交换部分非常小。我已添加注释以指示它的位置。临时变量在开头定义)

或 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

子SwapRanges将交换您给它的两个单元格范围。

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

但现在:

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

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

这是一个对我有用的示例...(我刚刚将 sub Example 分配给了按钮。)