Excel VBA: как поменять два выбранных диапазона ячеек (не только два значения) в одном столбце? - PullRequest
Новая
       26

Excel VBA: как поменять два выбранных диапазона ячеек (не только два значения) в одном столбце?

0 голосов
/ 03 мая 2018

Я бы хотел поменять выбранные диапазоны ячеек в одном и том же столбце без автоматической корректировки вложенных формул в других столбцах. Эти диапазоны ячеек почти всегда будут иметь неравный размер.

Я нашел код 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

Я знаю, что другим вариантом было бы удерживать 'shift' при перемещении диапазонов ячеек (работает отлично), но тогда все присоединенные формулы будут менять свою ссылку, которую я не хочу (например, если у меня есть формула, ссылающаяся на ячейку) A1, и я где-то поменяю местами A1, формула будет ссылаться на новую позицию A1, но я хочу, чтобы формула все еще ссылалась на A1).

Я думаю, что другим вариантом было бы использовать INDIRECT ("G" & ROW ()), чтобы исправить это, но, поскольку это довольно ресурсоемкая формула, я бы хотел увидеть альтернативу.

Кроме того, последние два варианта не позволят мне использовать таблицы (которые я предпочел бы по другим причинам), потому что вы не можете менять ячейки в таблицах. Вот почему я настоятельно предпочитаю вариант VBA.

Надеюсь, вы мне поможете, спасибо! Возможно, нужно лишь немного откорректировать код VBA.

С уважением, Marco

РЕДАКТИРОВАТЬ: Если значительно проще поменять два одинаковых диапазона ячеек (например, охватывающих 5 ячеек каждый), то это также будет хорошим решением.

1 Ответ

0 голосов
/ 03 мая 2018 
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. Это будет работать только в том случае, если области указаны в столбце. Если выбор сделан для каждой строки, то результаты будут не такими, как ожидалось;

Что касается обмена цветами, если цвета всех ячеек на область одинаковы, это будет работать: 

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

Однако, если цвета ячеек для каждой области не одинаковы, то самый простой способ - скопировать + вставить первый диапазон в отдельный диапазон и работать оттуда.

...