Создать рамку в диапазоне для определенных критериев столбца c

Question

Go через указанный столбец c для каждой строки и для изменения границы на основе значений в этом столбце и ячейке (Worksheets (WS) .Cells (5, 3) .value), равных толще . Есть ли способ создать контурную границу вокруг всего диапазона используемых ячеек и получить ожидаемые результаты?

Текущий

Ожидаемые результаты

Ваши идеи / предложения приветствуются. Спасибо за вашу помощь!

Sub AddBorderColour(Col As Integer)
    Dim WS As String
    Dim i As Integer, r As Integer

    WS = ActiveSheet.Name

    ' Find the maximum rows used in each worksheet.
    r = Worksheets(WS).UsedRange.Columns.Count

    For i = 29 To r
        If Not (Worksheets(WS).Cells(5, 3).value = "") Then
            If Worksheets(WS).Cells(i, Col + 6).value = Worksheets(WS).Cells(5, 3).value Then
                Worksheets(WS).Range(Cells(i, Col).Address(), Cells(i, Col + 10).Address()).BorderAround LineStyle:=xlContinuous, Color:=vbBlack, Weight:=xlThick
            End If
        End If
    Next i
End Sub

Answer 1

За пару дней я написал макрос go, который должен был «обрамлять» определенные ячейки / диапазоны.

Я написал это:

Sub Framer(ws As Worksheet, sAdd As String)

With ws.Range(sAdd)
    .Borders(xlEdgeTop).Weight = xlThick
    .Borders(xlEdgeRight).Weight = xlThick
    .Borders(xlEdgeBottom).Weight = xlThick
    .Borders(xlEdgeLeft).Weight = xlThick
End With

End Sub

И затем для каждого ячейка / диапазон, который нам нужно создать, просто назовите это с именем WS, на котором находится ячейка / диапазон, и адресом ячейки / диапазона.

В вашем примере, как я бы это сделал написать отдельную подпрограмму, в которой я Dim 2 ссылки диапазона, скажем, rStart и rEnd, и найти способ определить, на какие ячейки они ссылаются. Я бы провел oop a for через крайний левый столбец с типом данных, который представляет для этого интерес. Go от первого ряда до последнего, и где цвет шрифта черный и цвет ячейки выше красный, сделайте следующее:

For i = [whatever] to lastrow
  '[black/red], obviously you will need to find the numbers and put those here
  If Range("A" & i).font.color = [black] AND Range("A" & i-1).font.color = [red]
    Set rStart = Range("A" & i)
    Exit For
  End if
Next i

После этого я начну с первая строка черного шрифта, смотрящая на цвет шрифта i-1-й строки:

'+100, make sure it's a number larger than the count of potential black rows in-a-row
For i = rStart.Row to rStart.Row+100
  If Range("A" & i+1).font.color = [red] then
    Set rEnd = Range("K" & i)
    Exit For
  End if
Next i

(вместо того, чтобы делать Do While или Until, мне нравится делать циклы for, где я пересекаюсь с конечное значение и просто сделайте Exit for.) Как только вы назначите rStart и rEnd, вы просто go

Call Framer(ws, Range(rStart, rEnd).Address)

Затем просто повторите это до нижней части таблицы , Я надеюсь, что это имеет смысл.

Answer 2

После того, как метод проб и ошибок окупится, я рад поделиться с вами следующим кодом, который может решить этот вопрос со всеми вами.

If Worksheets(WS).Cells(i, Col + 6).value = Worksheets(WS).Cells(i - 1, Col + 6).value Then Worksheets(WS).Range(Cells(i, Col).Address(), Cells(i, Col + 10).Address()).BorderAround LineStyle:=xlContinuous, Color:=vbBlack, Weight:=xlThick Worksheets(WS).Range(Cells(i, Col).Address(), Cells(i, Col + 10).Address()).Borders(xlEdgeTop).LineStyle = xlContinuous Worksheets(WS).Range(Cells(i, Col).Address(), Cells(i, Col + 10).Address()).Borders(xlEdgeTop).Color = vbBlack Worksheets(WS).Range(Cells(i, Col).Address(), Cells(i, Col + 10).Address()).Borders(xlEdgeTop).Weight = xlThin Else Worksheets(WS).Range(Cells(i, Col).Address(), Cells(i, Col + 10).Address()).BorderAround LineStyle:=xlContinuous, Color:=vbBlack, Weight:=xlThick End If

Answer 3

Если вы запишите это как макрос, это даст вам подсказку. Что на самом деле делает Excel, когда вы делаете это вручную в Excel, - это применение верхней границы к верхнему ряду выбранных ячеек, правой границы к правому столбцу ячеек при выборе и т. Д.

Код из моего записанного макроса:

Sub border()
'
' border Macro
'

'
    Range("C3:G12").Select
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    Selection.Borders(xlInsideVertical).LineStyle = xlNone
    Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
End Sub

Как обычно с записанным макросом, большая часть кода там на самом деле не нужна, но вы поняли!