Динамическое объединение и центрирование ячеек по значению переменной с использованием VBA

Question

Я пытаюсь объединить и центрировать x количество ячеек, используя статическую начальную точку с VBA.

Моя начальная точка всегда будет Cell D69, и я всегда буду объединять столбцы D - I вместеначиная с строки 69, а затем выравнивая текст по левому краю.

Мой текущий макрос для этого выглядит следующим образом:

Range("D69:I69").Select
        With Selection
            .HorizontalAlignment = xlCenter
            .VerticalAlignment = xlBottom
            .Orientation = 0
            .AddIndent = False
            .IndentLevel = 0
            .ShrinkToFit = False
            .ReadingOrder = xlContext
            .MergeCells = False
        End With
        Selection.merge
        With Selection
            .HorizontalAlignment = xlLeft
            .VerticalAlignment = xlBottom
            .WrapText = False
            .Orientation = 0
            .AddIndent = False
            .IndentLevel = 0
            .ShrinkToFit = False
            .ReadingOrder = xlContext
            .MergeCells = True
        End With

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

Answer 1

1. Определение последней строки
2. Цикл каждой строки (начиная с 69) с объединением из D to I
3. После завершения цикла отформатируйте весь диапазон сразу

Это также проверяет, что ваша последняя строка действительно больше 69, в противном случае это приведет к ошибке.

---

Option Explicit

Sub Merge_For_Client()

Dim ws As Worksheet: Set ws = ThisWorkbook.Sheets("Sheet1") '<-- Update Sheet
Dim LR As Long, i As Long

LR = ws.Range("D" & ws.Rows.Count).End(xlUp).Row

Application.ScreenUpdating = False
Application.DisplayAlerts = False
    If LR >= 69 Then

        For i = 69 To LR
            ws.Range(ws.Cells(i, "D"), ws.Cells(i, "I")).Merge
        Next i

        With ws.Range(ws.Cells(69, "D"), ws.Cells(LR, "I"))
            .HorizontalAlignment = xlLeft
            'Add any other formats you want to apply in this With Block
        End With

    End If
Application.DisplayAlerts = True
Application.ScreenUpdating = True

End Sub

Answer 2

Посмотрите, поможет ли это, более подробно в комментариях к коду:

Sub mergeThis()

Dim ws As Worksheet: Set ws = ThisWorkbook.Sheets("SheetName") 'declare and set the worksheet, set your sheet name.
Dim X As Long, howManyTimes As Long 'declare variables to use

howManyTimes = 100 'set how many times here. See additional code for how to get this to last row instead


    For X = 0 To howManyTimes 'loop from 0 to so many times
        With ws.Range("D69:I69").Offset(X) 'use offset from range to get the new range to deal with
            .MergeCells = True
            .HorizontalAlignment = xlLeft
        End With
    Next X
End Sub

Я удалил все значения по умолчанию из слияния / формата, не имеет значения, если они не установлены на другое значение.

Теперь есть способы получить последний ряд, если это то, что вам нужно.Просто добавьте:

Dim lRow As Long: lRow = ws.Cells(Rows.Count, 4).End(xlUp).Row

howManyTimes = lRow

Answer 3

Если ваш код работает нормально:

Этот простой цикл должен помочь

x = 5 'Sample Value

For i = 69 To 69 + x


    Range("D" & i & ":I" & i).Select
        With Selection
            .HorizontalAlignment = xlCenter
            .VerticalAlignment = xlBottom
            .Orientation = 0
            .AddIndent = False
            .IndentLevel = 0
            .ShrinkToFit = False
            .ReadingOrder = xlContext
            .MergeCells = False
        End With
        Selection.Merge
        With Selection
            .HorizontalAlignment = xlLeft
            .VerticalAlignment = xlBottom
            .WrapText = False
            .Orientation = 0
            .AddIndent = False
            .IndentLevel = 0
            .ShrinkToFit = False
            .ReadingOrder = xlContext
            .MergeCells = True
        End With

Next