如何循环 Excel 中的边框并改变它们的颜色？

Question

我正在尝试循环浏览 Excel 中的活动边框并将其颜色更改为 "next one"。

这是我的代码：

Dim Color1 As Variant
Dim Color2 As Variant
Dim Color3 As Variant
Dim Color4 As Variant
Dim Color5 As Variant

Color_default = RGB(0, 0, 0)
Color1 = RGB(255, 0, 0)
Color2 = RGB(0, 255, 0)
Color3 = RGB(0, 0, 255)
Color4 = RGB(222, 111, 155)
Color5 = RGB(111, 111, 111)

Dim cell As Range
Dim positions As Variant
Dim i As Integer

positions = Array(xlDiagonalDown, xlDiagonalDown, xlEdgeLeft, xlEdgeTop, xlEdgeBottom, xlEdgeRight, xlInsideVertical, xlInsideHorizontal)

For Each cell In Selection
    For i = LBound(positions) To UBound(positions)
        If cell.BORDERS(positions(i)).LineStyle <> xlNone Then
            If cell.BORDERS(positions(i)).Color = Color_default Then
                cell.BORDERS(positions(i)).Color = Color1
            ElseIf cell.BORDERS(positions(i)).Color = Color1 Then
                cell.BORDERS(positions(i)).Color = Color2
            ElseIf cell.BORDERS(positions(i)).Color = Color2 Then
                cell.BORDERS(positions(i)).Color = Color3
            ElseIf cell.BORDERS(positions(i)).Color = Color3 Then
                cell.BORDERS(positions(i)).Color = Color4
            ElseIf cell.BORDERS(positions(i)).Color = Color4 Then
                cell.BORDERS(positions(i)).Color = Color5
            Else
                cell.BORDERS(positions(i)).Color = Color_default
            End If
        End If
    Next i
Next cell

有效。它不会更改边框的权重，也不会添加新边框（仅更改现有边框）。

问题是当两个单元格在附近时，外边框变为 "next+1" 颜色，内边框变为 "next+2" 颜色，因为它们循环了两次。

编辑：代码应该检查现有的边框颜色是否是我想要使用的颜色。其次，首先要统一颜色，避免选区内有多种边框颜色。

问题图片

我想统一边框，然后能够循环显示它们的颜色，而不管它们的权重是多少，并且不添加新边框。

Answer 1

这是一种方法 - 注意我删除了你的一些边框枚举 - 如果你在每个单元格上循环，那么你可能会忽略 "outer" 边框。

它首先循环查找需要更改的内容，但在第一个循环中不设置任何边框颜色。在第二个循环中，它会更新，但不会更改已作为先前单元格更新的一部分更改的边框。

Sub BorderColor()

    Dim cell As Range
    Dim positions As Variant
    Dim i As Long, clrNow As Long, clrNext As Long, Pass As Long
    Dim col As New Collection, arr

    positions = Array(xlEdgeLeft, xlEdgeTop, xlEdgeBottom, xlEdgeRight)

    For Each cell In Range("C4:F11").Cells
        For i = LBound(positions) To UBound(positions)
            If cell.Borders(positions(i)).LineStyle <> xlNone Then
                With cell.Borders(positions(i))
                    'store the cell, border position, current color and new color
                    col.Add Array(cell, positions(i), .Color, NextColor(.Color))
                End With
            End If
        Next i
    Next cell
    'now loop and set the new color if needed
    For Each arr In col
        Set cell = arr(0)
        With cell.Borders(arr(1))
            'only change the color if it hasn't already been changed
            If .Color = arr(2) Then .Color = arr(3)
        End With
    Next


End Sub

'get next color (cycles through array)
Function NextColor(currentColor As Long) As Long
    Dim arr, i As Long, rv As Long
    arr = Array(RGB(0, 0, 0), RGB(255, 0, 0), _
                RGB(0, 255, 0), RGB(0, 0, 255), _
                RGB(222, 111, 155), RGB(111, 111, 111))
    rv = -1
    For i = LBound(arr) To UBound(arr)
        If currentColor = arr(i) Then
            If i < UBound(arr) Then
                rv = arr(i + 1)
            Else
                rv = arr(LBound(arr))
            End If
            Exit For
        End If
    Next
    If rv = -1 Then rv = RGB(0, 0, 0) 'default next
    NextColor = rv
End Function

Answer 2

这段代码应该可以满足您的需求。它从选区内带框的单元格中读取现有颜色，确定下一个要设置的颜色并相应地设置所有颜色。

Sub CycleBorderColors(Optional ByVal Reset As Boolean)

    Dim BorderColor As Variant
    Dim BorderPos As Variant
    Dim CurrentColor As Long
    Dim ColorIndex As Long
    Dim Cell As Range
    Dim i As Integer


    BorderPos = Array(xlDiagonalDown, xlDiagonalUp, xlEdgeLeft, xlEdgeTop, _
                      xlEdgeBottom, xlEdgeRight, xlInsideVertical, xlInsideHorizontal)
    BorderColor = Array(RGB(0, 0, 0), RGB(255, 0, 0), RGB(0, 255, 0), _
                        RGB(222, 111, 155), RGB(111, 111, 111))

    If Reset Then
        ColorIndex = Reset
    Else
        CurrentColor = xlNone
        ' read the border color of the first selected cell with a border
        For Each Cell In Selection.Cells
            For i = LBound(BorderPos) To UBound(BorderPos)
                With Cell
                    If .Borders(BorderPos(i)).LineStyle <> xlNone Then
                        CurrentColor = .Borders(BorderPos(i)).Color
                        Exit For
                    End If
                End With
            Next i
            If CurrentColor <> xlNone Then Exit For
        Next Cell
        If CurrentColor = xlNone Then
            MsgBox "The selection includes no cells with borders.", _
                   vbInformation, "Inapplicable selection"
            Exit Sub
        End If

        For ColorIndex = UBound(BorderColor) To 0 Step -1
            If BorderColor(ColorIndex) = CurrentColor Then Exit For
        Next ColorIndex
        ' ColorIndex will be -1 if not found
    End If
    ColorIndex = ColorIndex + 1                 ' set next color
    If ColorIndex > UBound(BorderColor) Then ColorIndex = 0

    For Each Cell In Selection
        For i = LBound(BorderPos) To UBound(BorderPos)
            If Cell.Borders(BorderPos(i)).LineStyle <> xlNone Then
                Cell.Borders(BorderPos(i)).Color = BorderColor(ColorIndex)
            End If
        Next i
    Next Cell
End Sub

该过程有一个可选参数，如果将其设置为 True，则会导致重置。当前程序将边框颜色设置为默认值。事后看来，这个想法并不那么热门，因为您可能会通过运行代码 4 次或更少次导致重置。但当我开始时，这似乎是个好主意。现在您可能更愿意删除该功能。最简单的方法是从声明中删除参数，将 Dim Reset As Boolean 添加到变量声明并将其余部分留给它自己。

虽然您可以选择重置，但请使用中介来调用该过程。下面显示的三种变体中的任何一种都可以使用。

Sub CallCycleBorderColors()
    CycleBorderColors
  ' CycleBorderColors True
  ' CycleBorderColors False
End Sub

从工作表中调用子 CallCycleBorderColors。

Answer 3

你没有上传你的图片 cell.border 所以我不知道你想怎么工作。

我假设在选择时，边框颜色最初是相同的，并且它们是您提供的颜色。试试这个：

Sub Test()
    Dim color As Variant, cell As Range
    Dim arr_Color, Arr_Border, Index, item
    'black-> red -> green -> blue -> pink-> Brown-> black
    arr_Color = Array(RGB(0, 0, 0), RGB(255, 0, 0), RGB(0, 255, 0), _
                      RGB(0, 0, 255), RGB(222, 111, 155), RGB(111, 111, 111), RGB(0, 0, 0))
    Arr_Border = Array(xlEdgeLeft, xlEdgeTop, xlEdgeRight, xlEdgeBottom)
    Dim origin As Range: Set origin = selection
    For Each item In Arr_Border
            If item = xlEdgeRight Then
                Set selection = selection.Resize(selection.Rows.Count, 1).Offset(0, selection.Columns.Count - 1)
            End If
            If item = xlEdgeBottom Then
                Set selection = origin.Resize(1, origin.Columns.Count).Offset(origin.Rows.Count - 1, 0)
            End If
        For Each cell In selection.Cells
        color = cell.Borders(item).color
        Index = Application.Match(color, arr_Color, 0)
            If Not (IsError(Index)) Then
            color = arr_Color(Index)
                If cell.Borders(item).LineStyle <> xlLineStyleNone Then
                     cell.Borders(item).color = color
                End If
            End If
        Next cell

    Next item
End Sub

备注：

-循环遍历单元格时不需要 xlInsideVertical、xlInsideHorizontal。

-我将在遍历每个单元格之前循环遍历边缘类型

如何循环 Excel 中的边框并改变它们的颜色？

How to cycle through borders in Excel and change their color?

excel

vba

loops

border