エクセル マクロ VBA 罫線 文字列
職場で使う表をVBAマクロを用いて罫線作成をしています。
前任者のアレンジを頼まれたのですが前任者に連絡が取れず困っています。
表の特徴は以下のようになります。
・A列を飛ばし、B列から2列飛びで文字を記入
・b2=曜日、b3=1、b4=2、b5=3、b6=4、b7=空白のセットが曜日ごとに2セット×7日分
この表を
・b2=曜日、b3=-3、b4=-2、b5=-1、b6=0、b7=1、b8=2、b9=3、b10=4、b11=空白のセットが曜日ごとに2セット×7日分
に変更したいのですが空欄の場所がずれてしまい上手くいきません。
原本のマクロは以下です。
----------------------------------------------------------------
Sub 罫線作成()
Range(Cells(4, 1), Cells(86, 22)).Select
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
Selection.Borders(xlEdgeLeft).LineStyle = xlNone
Selection.Borders(xlEdgeTop).LineStyle = xlNone
Selection.Borders(xlEdgeBottom).LineStyle = xlNone
Selection.Borders(xlEdgeRight).LineStyle = xlNone
Selection.Borders(xlInsideVertical).LineStyle = xlNone
Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
ch1 = "月火水木金土日"
For i = 4 To 76 Step 12
n1 = (i + 8) \ 12
Range(Cells(i, 1), Cells(i + 10, 22)).Select
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.Weight = xlMedium
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlMedium
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlMedium
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.Weight = xlMedium
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlInsideVertical)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlInsideHorizontal)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
'Cells(i, 1) = Mid(ch1, n1, 1)
For i2 = 2 To 20 Step 3
For i3 = i To i + 10
nb1 = (i3 + 8) Mod 12
If nb1 = 0 Or nb1 = 6 Then Cells(i3, i2) = Mid(ch1, n1, 1)
If nb1 = 1 Or nb1 = 7 Then Cells(i3, i2) = 1
If nb1 = 2 Or nb1 = 8 Then Cells(i3, i2) = 2
If nb1 = 3 Or nb1 = 9 Then Cells(i3, i2) = 3
If nb1 = 4 Or nb1 = 10 Then Cells(i3, i2) = 4
Next
Next
Next
End Sub
----------------------------------------------------------------
4行目から142行目まで使用することは分かっているのですが…
どうかご助力お願いします。
補足
早速のご回答ありがとうございます。 空白でも、文字が入っていても線を引けてしまいます。A列に文字が入ったら線を引くにしたいのです。 全文表示します。 Dim bolFlg As Boolean Dim intCount As Integer Range("a1").Select ActiveCell.CurrentRegion.BorderAround xlContinuous, xlThin 最下行 = Range("a1").CurrentRegion.Rows.Count '最下列 = Range("a1").CurrentRegion.Column.Count bolFlg = True: intCount = 0 For c = 1 To 最下行 - 1 intCount = intCount + 1 If Cells(c, 4) = "" Then Range(Cells(c, 1), Cells(c, 6)).Select With Selection.Borders(xlEdgeBottom) .LineStyle = xlDot .Weight = xlThin .ColorIndex = xlAutomatic End With With Selection.Borders(xlEdgeTop) .LineStyle = xlContinuous .Weight = xlThin .ColorIndex = xlAutomatic End With bolFlg = True Else If bolFlg = True Then Range(Cells(c, 1), Cells(c, 6)).Select With Selection.Borders(xlEdgeBottom) .LineStyle = xlDot .Weight = xlThin .ColorIndex = xlAutomatic End With With Selection.Borders(xlEdgeTop) .LineStyle = xlContinuous .Weight = xlThin .ColorIndex = xlAutomatic End With Else Range(Cells(c, 1), Cells(c, 6)).Select With Selection.Borders(xlEdgeTop) .LineStyle = xlDot .Weight = xlThin .ColorIndex = xlAutomatic End With End If bolFlg = False If Cells(c, 4) = "数量" Then bolFlg = True End If If c <= 56 Then If intCount = 55 Then Range(Cells(c + 1, 1), Cells(c + 1, 6)).Select With Selection.Borders(xlEdgeBottom) .LineStyle = xlDot .Weight = xlThin .ColorIndex = xlAutomatic End With With Selection.Borders(xlEdgeTop) .LineStyle = xlContinuous .Weight = xlThin .ColorIndex = xlAutomatic End With intCount = 0 End If Else If intCount = 56 Then Range(Cells(c + 1, 1), Cells(c + 1, 6)).Select With Selection.Borders(xlEdgeBottom) .LineStyle = xlDot .Weight = xlThin .ColorIndex = xlAutomatic End With With Selection.Borders(xlEdgeTop) .LineStyle = xlContinuous .Weight = xlThin .ColorIndex = xlAutomatic End With intCount = 0 End If End If End If ActiveCell.Offset(1, 0).Select Next c Range(Cells(56, 1), Cells(56, 6)).Select With Selection.Borders(xlEdgeBottom) .LineStyle = xlContinuous .Weight = xlThin .ColorIndex = xlAutomatic End With With Selection.Borders(xlEdgeTop) .LineStyle = xlContinuous .Weight = xlThin .ColorIndex = xlAutomatic End With End Sub