Поменяйте местами две соседние ячейки

Question

Я действительно не могу заставить этот простой код работать.

Sub SwapNumbers()

Dim x As Integer, y As Integer, tempB As Integer

x = Range("B3")

y = Range("C3")

tempB = x

Range("C3") = x

Range("B3") = y

End Sub

Как удалить указанную ячейку c и сделать ее двумя смежными ячейками?

Спасибо!

Answer 1

Я думаю, что это должно сделать это. Вы также можете проверить, что ячейки содержат целые числа.

Sub Swap()

Dim tempB As Long

With Selection
    If .Rows.Count = 1 And .Count = 2 And .Cells(1).Column = .Cells(2).Column - 1 Then
        tempB = .Cells(1).Value
        .Cells(1).Value = .Cells(2).Value
        .Cells(2).Value = tempB
    Else
        MsgBox "Select 2 adjacent cells in the same row"
    End If
End With

End Sub

Answer 2

Это будет работать с любыми двумя ячейками, независимо от того, подключены они или нет:

Sub swap()
    With Selection
        If .Count <> 2 Then Exit Sub
        Dim arr(1 To 2) As Variant

        Dim x As Long
        x = 1

        Dim cl As Range
        For Each cl In Selection
            arr(x) = cl
            x = x + 1
        Next cl

        x = 2

        For Each cl In Selection
            cl.Value = arr(x)
            x = x - 1
        Next cl
     End With

End Sub