Блог

Главная - Вопросы по программированию - EXCEL-VBA-Как Поменять Местами Защиту ячеек двух диапазонов

EXCEL-VBA-Как Поменять Местами Защиту ячеек двух диапазонов

#excel #vba

Вопрос:

Следующий код ниже меняет местами значения двух диапазонов:

 Dim rng As Range
Dim StoredRng As Variant

Set rng = Selection

'Store first selected cell area
  StoredRng = rng.Areas(1).Cells.Value

'Swap first area with the second
rng.Areas(1).Cells.Value = rng.Areas(2).Cells.Value
    For Each cell In rng.Areas(1)
        If rng.Areas(1).Locked = False Then
            rng.Locked = True
        End If
        
    Next
        
  
'Populate second area with the first
rng.Areas(2).Cells.Value = StoredRng
    For Each cell In rng.Areas(2)
        If rng.Areas(2).Locked = False Then
            rng.Locked = True
        End If
    Next

Однако я также хочу поменять местами защиту. Другими словами, если в области 1 есть все заблокированные ячейки, кроме двух, а в области 2 есть все заблокированные ячейки, как я могу поменять их местами?

Комментарии:

1. Все ли клетки в одной области имеют одинаковую защиту? Поскольку все ячейки в диапазоне 1 заблокированы, смешивания нет.

2. Нет, сэр. Область 1 полностью заблокирована, за исключением двух ячеек. Зона 2 полностью заблокирована. Я обновил свой вопрос. Спасибо за разъяснение.

3. Затем вам нужно будет зациклить одну из областей и сделать то же самое, что и вы, с формулой для заблокированного/разблокированного. Или, если вам все равно, вы можете сделать специальную вставку для копирования форматов.

4. Я хочу, чтобы форматы остались неизменными. Просто поменяйте местами значения и только защиту ячеек.

5. Да, но ваш код должен это подтвердить, а не предполагать. Точно так же, как ваш код предполагает, что rng у этого есть по крайней мере 2 области. Также, если вас интересует значение двух диапазонов, то понятнее использовать .Value и не .Formula использовать .

Ответ №1:

 Option Explicit

Sub test_swapLocked()

With ThisWorkbook
    'This fails due to unequal ranges
    Dim rg1 As Range: Set rg1 = Union(.ActiveSheet.Cells(1, 1), .Names("rg.1.1").RefersToRange, .Names("rg.1.2").RefersToRange)
   'This succeeds
   'Dim rg1 As Range: Set rg1 = Union(.Names("rg.1.1").RefersToRange, .Names("rg.1.2").RefersToRange)
    Dim rg2 As Range: Set rg2 = Union(.Names("rg.2.1").RefersToRange, .Names("rg.2.2").RefersToRange)
End With

Dim isLocked1 As Boolean, islocked2 As Boolean
isLocked1 = rg1.Areas(2).Cells(1, 2).Locked
islocked2 = rg2.Areas(2).Cells(1, 2).Locked

Debug.Assert isLocked1 <> islocked2

swapLockedForTwoRanges rg1, rg2

Debug.Assert rg1.Areas(2).Cells(1, 2).Locked = islocked2
Debug.Assert rg2.Areas(2).Cells(1, 2).Locked = isLocked1

End Sub



Public Sub swapLockedForTwoRanges(rg1 As Range, rg2 As Range)

If areRangesOfSameSize(rg1, rg2) = False Then
    Err.Raise vbObjectError, , "Ranges have to be of same size"
End If

Dim c1 As Range, c2 As Range

Dim isLocked1 As Boolean, islocked2 As Boolean

Dim a As Long, r As Long, c As Long

For a = 1 To rg1.Areas.Count
    For r = 1 To rg1.Areas(a).Rows.Count
        For c = 1 To rg1.Areas(a).Columns.Count
            Set c1 = rg1.Areas(a).Cells(r, c): Set c2 = rg2.Areas(a).Cells(r, c)
            isLocked1 = c1.Locked: islocked2 = c2.Locked
            c1.Locked = islocked2: c2.Locked = isLocked1
        Next
    Next
Next

End Sub



Public Function areRangesOfSameSize(rg1 As Range, rg2 As Range) As Boolean

Dim a As Long, r As Long, c As Long

If rg1.Areas.Count <> rg2.Areas.Count Then Exit Function

For a = 1 To rg1.Areas.Count
    For r = 1 To rg1.Areas(a).Rows.Count
        If rg1.Areas(a).Rows.Count <> rg2.Areas(a).Rows.Count Then Exit Function
        For c = 1 To rg1.Areas(a).Columns.Count
            If rg1.Areas(a).Rows(r).Columns.Count <> rg2.Areas(a).Rows(r).Columns.Count Then Exit Function
        Next
    Next
Next
areRangesOfSameSize = True

End Function

Комментарии:

1. Пожалуйста, добавьте описание, объясняющее изменения, которые вы внесли в код, чтобы дать хороший ответ.

Ответ №2:

Я смог найти ответ сам. Приведенный ниже код был протестирован и работает:

 Set rng1 = Range("Q47:Q48")
Set rng2 = Range("S47:S48")

Range(rng1, rng2).Select

If rng1.Locked = False Then
    rng1.Locked = True
    rng2.Locked = False
    
ElseIf rng2.Locked = False Then
    rng1.Locked = False
    rng2.Locked = True
End If
Метки: