Как использовать MergeArea - PullRequest
1 голос
/ 17 января 2020

Было предложено в предыдущем вопросе использовать MergeArea . Я посмотрел это, но не понял, что я читал достаточно, чтобы использовать это и нашел альтернативное решение моей проблемы вместо этого.

Я возился с головоломкой судоку и искал способ легко разблокировать / заблокировать оригинальную головоломку, вернуться к исходной, стереть головоломку как способ оттачивать свои навыки программирования на VBA.

Код должен был принять это:

Unlocked Puzz

И превратить его в это:

Locked Puzz

Поскольку A3 фактически является частью объединенного A3: E3, код испортил все, когда я попытался применить изменения свойства ячейки только к части объединенной ячейки. Он продолжал выдавать ошибку 1004. Я получил приведенный ниже код, убедившись, что весь объединенный диапазон был взят.

Sub Lock_Puzz()

Dim counter_x As Long
Dim counter_y As Long
Dim OriginalEntries As Range

    Sheet1.Unprotect ("")

    With Sheet1
        For counter_y = 3 To 27 Step 3
            For counter_x = 1 To 41 Step 5
                If Sheet1.Cells(counter_y, counter_x) <> "" Then
                    Set OriginalEntries = Combine(OriginalEntries, .Range(.Cells(counter_y, counter_x), .Cells(counter_y, counter_x + 4)))
                End If
            Next counter_x
        Next counter_y
    End With

    With OriginalEntries
        .Locked = True
        .Font.Color = -52429
        .Interior.ThemeColor = xlThemeColorDark1
        .Interior.TintAndShade = -4.99893185216834E-02
    End With

    Sheet1.Protect ("")

End Sub

Функция Combine - это функция, предоставленная Матье Гиндоном в предыдущем вопросе 1028 * который позволяет выполнять UNION, когда один из диапазонов пуст.

Моя процедура разблокировки аналогична, но захватывает диапазон A3: AS3 и меняет Locked = False

Dim counter_x As Long
Dim Entries As Range

    With Sheet1
        For counter_x = 3 To 27 Step 3
            Set Entries = Combine(Entries, .Range("A" & counter_x & ":AS" & counter_x))
        Next counter_x
    End With

    Sheet1.Unprotect ("")
    With Entries
        .Locked = False
        .Interior.ColorIndex = xlColorIndexNone
        .Font.ColorIndex = xlAutomatic
        If Clear_Contents Then
            .ClearContents
        End If
    End With
    Sheet1.Protect ("")

Поскольку это только я возиться и пытаться научить себя, как использовать VBA, может кто-то изменить один из кодов, чтобы показать, как они будут использовать MergeArea . (Или напишите свой!)

Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...