可変セル値vbaに基づいて列を強調表示

Question

セルの値に基づいて自動的に棒のような列を強調したいと思います。

例： 3h - >塗りつぶし色の値の横の3列を強調表示し、バーのように枠線で囲みます。

1h - >値の横にあるハイライト1の列。

1.5h - >ハイライトの1列目など。

私はこのコードで試してみましたが、動作しますが、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, 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 

Answer 2

これを試していないしてください：

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