Создание массива, который завершает все настройки границ за один проход

Question

Я пытаюсь настроить массив для вытягивания типов границ в Excel, чтобы я мог создать все свои границы в пару строк, а не> 40 обычно

Я явно скучаючто-то очевидное, но в данный момент я не могу решить это. Может ли кто-нибудь помочь с этим?

Текущая ошибка: Object doesn't support this property or method (Error 438)

Это приводит к .LineStyle = xlContinuous строке

Разве i не правильный путь для этого?Любая помощь приветствуется

Dim wb As Workbook, ws As Worksheet, rng As Range, LastRow As Long, rng2 As Range, borderType, i

borderType = Array("xlEdgeLeft", "xlEdgeTop", "xlEdgeBottom", "xlEdgeRight", "xlInsideVertical", "xlInsideHorizontal")
Set wb = ThisWorkbook
Set ws = Worksheets("Data")
Set rng = ws.Cells(1, 1)

    LastRow = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row                  'Finds the bottom populated row

Set rng2 = ws.Range(rng, ws.Cells(LastRow, 15))

    With rng2
        .AutoFilter
        .EntireColumn.AutoFit
        .Borders(xlDiagonalDown).LineStyle = xlNone
        .Borders(xlDiagonalUp).LineStyle = xlNone


        For Each i In borderType
            .LineStyle = xlContinuous
            .ColorIndex = 0
            .TintAndShade = 0
            .Weight = xlThin
        Next

    End With

Answer 1

Что-то вроде этого, вероятно, то, что вы ищете:

Sub tgr()

    Dim ws As Worksheet
    Dim aBorderSettings() As Long
    Dim i As Long

    Set ws = ThisWorkbook.Worksheets("Data")

    ReDim aBorderSettings(1 To 8, 1 To 2)
        aBorderSettings(1, 1) = xlDiagonalDown:     aBorderSettings(1, 2) = xlNone
        aBorderSettings(2, 1) = xlDiagonalUp:       aBorderSettings(2, 2) = xlNone
        aBorderSettings(3, 1) = xlEdgeBottom:       aBorderSettings(3, 2) = xlContinuous
        aBorderSettings(4, 1) = xlEdgeLeft:         aBorderSettings(4, 2) = xlContinuous
        aBorderSettings(5, 1) = xlEdgeRight:        aBorderSettings(5, 2) = xlContinuous
        aBorderSettings(6, 1) = xlEdgeTop:          aBorderSettings(6, 2) = xlContinuous
        aBorderSettings(7, 1) = xlInsideHorizontal: aBorderSettings(7, 2) = xlContinuous
        aBorderSettings(8, 1) = xlInsideVertical:   aBorderSettings(8, 2) = xlContinuous

    With ws.Range("A1:O" & ws.Cells(ws.Rows.Count, "A").End(xlUp).Row)
        .AutoFilter
        .EntireColumn.AutoFit
        For i = LBound(aBorderSettings, 1) To UBound(aBorderSettings, 1)
            .Borders(aBorderSettings(i, 1)).LineStyle = aBorderSettings(i, 2)
            If aBorderSettings(i, 2) <> xlNone Then
                .Borders(aBorderSettings(i, 1)).ColorIndex = 0
                .Borders(aBorderSettings(i, 1)).TintAndShade = 0
                .Borders(aBorderSettings(i, 1)).Weight = xlThin
            End If
        Next i
    End With

End Sub