Question

我想自动突出显示基于单元格值的栏。

EG。 3h - ＆gt;使用填充颜色突出显示值旁边的3列，并以条形为边框。

1h - ＆gt;突出显示值旁边的1列。

1.5h - ＆gt;突出显示一列半列等。

我尝试使用下面的代码，但它只能突出显示并在B1添加列。如果我更改为将范围添加到整列，则宏不起作用。

`Sub TimingBars()
If Range("B1").Value <= 0 Then Exit Sub
With Range(Cells(1, 3), Cells(1, 2 + Range("B1"))).EntireColumn
  .Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Range(Cells(1, 3), Cells(1, 2 + Range("B1"))).Interior.Color = vbBlue

End With
End Sub`

请帮助谢谢！

Answer 1

请试试这个：

Sub TimingBars()
Dim i, BarLimit As Integer
Dim Rg As Range
Set Rg = Range("B1:B100") ' change this range as you want

For Each cell In Rg
  For i = 1 To cell.Value Step 1
   Cells(cell.Row, cell.Column + i).Interior.Color = vbBlue
  Next i
Next cell
End Sub

Answer 2

如果要对突出显示的单元格进行边框处理：

Sub TimingBars()
Dim i, BarLimit As Integer
Dim Rg, RgBar As Range
Set Rg = Range("B1:B100")

For Each cell In Rg
 If cell.Value > 0 Then

    Set RgBar = Range(Cells(cell.Row, cell.Column + 1), Cells(cell.Row, cell.Column + cell.Value))
    RgBar.Interior.Color = vbBlue
    With RgBar.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With RgBar.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With RgBar.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With RgBar.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
    End With
  End If

Next cell
End Sub

基于可变单元格值vba突出显示列

2 个答案: