空白でない場合に罫線を引く

質問

すみません。VBはまったくわからないので教えてください。

"A2"のセルに 何か文字がある場合、B2～G2 まで罫線(上段のみ)を
記述する方法を教えてください。
また、A3のセルに、何か文字がある場合は、 B3～G3まで罫線を
記述したいです。（以下、A4,A5と同様。つまりA列がキーになる。）

いつもは、条件付書式を用いるのですが、既に３つの条件付書式を
設定しており、それ以上、条件付書式を追加することができません。

よろしくお願いします。

回答No.2

hige_082 · ベストアンサー

マクロの問題だけではないと思います

まずはマクロから

’画面の更新を止める
Private Sub CommandButton2_Click()
Dim w_End As Long
Dim w_Loop As Long
Application.ScreenUpdating = False　　’追加
　　　・
　　　・
　　　・
　End If
　Next i
Application.ScreenUpdating = True　　’追加
End Sub

’Selectを使わない
’（処理速度は変わりませんが、Wichの間にIf文を書いた方が、見た目スッキリすると思います）

　　　　・
　　　　・
　With Range(Cells(i, 5), Cells(i, 87)).Borders(xlEdgeTop)　　’変更するのはココ
　　　If IsEmpty(Cells(i, 2)) Then
　　　　.LineStyle = xlDash
　　　　.Weight = xlHairline
　　　　.ColorIndex = xlAutomatic
　　　Else
　　　　.LineStyle = xlContinuous
　　　　.Weight = xlThin
　　　　.ColorIndex = xlAutomatic
　　　End If
　End With
　　　　・
　　　　・

’もしかすると、これが一番有効かも
’マクロ処理中、再計算を止める（手動にする）

Private Sub CommandButton2_Click()
Dim w_End As Long
Dim w_Loop As Long
Application.Calculation = xlManual　　’追加
Application.ScreenUpdating = False
　　　・
　　　・
　　　・
　End If
　Next i
Application.ScreenUpdating = True
Application.Calculation = xlAutomatic　　’追加
End Sub

ダミーデータ1000行で、処理速度を各10回測定してみました
結果は
オリジナルコードで、平均4.5秒
　　〃　　に画面更新禁止適用で、平均1秒
　　〃　　にSelectを使わない適用で、平均1秒　でした

マクロ処理中、再計算を止めるは
＞初めてまともに VBA を作りましたが、パフォーマンスが悪くて
マシンが止まってしまいます。
ダミーデータ1000行で処理しても、5秒前後の処理なので
後、考えられるのは、関数の再計算ぐらいしかないと思います
再計算の必要があるなら
END SUBの前に
ActiveSheet.Calculateを追加してください

以上、参考にしてみてください

お礼

ご親切にありがとうございました。
おかげさまで、パフォーマンスもよくなりました。

回答No.1

Gizensha

このばあいはVBというよりVBAですね。
ヒントだけ。

罫線の引き方はマクロの記録で確認できます。
セルの内容はCellsやValueあたりをキーワードにさがせば見つかるかと。

お礼

初めてまともに VBA を作りましたが、パフォーマンスが悪くて
マシンが止まってしまいます。どこを直すか教えてください。
※対象行は　200～300行くらいあります。

Private Sub CommandButton2_Click()
Dim w_End As Long
Dim w_Loop As Long

　w_End = Range("E65536").End(xlUp).Row　　最後行取得
　w_Loop = w_End - 1

　For i = 9 To w_Loop　　　　　　　 ９行目から開始
　If IsEmpty(Cells(i, 2)) Then　　　セル:Bn が空白のとき点線
　　　　　　　　　　　　　　　　　　　　Bn～CInまで点線
　　　Range(Cells(i, 5), Cells(i, 87)).Select
　　　With Selection.Borders(xlEdgeTop)
　　　　.LineStyle = xlDash
　　　　.Weight = xlHairline
　　　　.ColorIndex = xlAutomatic
　　　End With
　Else 　　　　　　　　　　　　　　　　　空白でない⇒実線
　　　Range(Cells(i, 5), Cells(i, 87)).Select
　　　With Selection.Borders(xlEdgeTop)
　　　　.LineStyle = xlContinuous
　　　　.Weight = xlThin
　　　　.ColorIndex = xlAutomatic
　　　End With
　End If
　Next i
End Sub