MENU

データの変わり目に、罫線を引きたい

VBA初心者でも、すぐエクセルの自動化ができます。

質問

データの変わり目に、罫線を引きたい

f:id:The-Alchemist:20220202072908p:plain

①関数の入力

f:id:The-Alchemist:20220202074130p:plain

データの変わり目を把握するため、A列で下のセルと値が異なったらfalseを表示する作業列を、H列に作成します。なお、関数は=EXACT(LEFT(A2),LEFT(A3,1))です。

さて、H2列はデータが無く、最終行を把握できません。そこで、処理する範囲を”f2から”とし、数式の入力位置右に2つOffsetした”h2”にします。

 

②罫線を引く

f:id:The-Alchemist:20220202073730p:plain

作業列のH列がFalseの場合、H列から左に7オフセット(0,-7)し、右に6リサイズ(,6)

したセルに罫線を引きます。

 

③作業列のクリアする

f:id:The-Alchemist:20220202074843p:plain

最後に、作業列をクリアします。

  

アプリの画面

①関数の入力

f:id:The-Alchemist:20220203120135p:plain



左が設定画面です。

 

 

 

 

左上は、データがある右端列にします。

 

範囲オプションを、最終行までにします。

 

 

 

 

 

 

関数を入れます。数式は=で始め”で囲みます。

 

データの右端列から、2つ右に移動したセルに入力します。

 

 

 

 

 

 

 

 

②罫線を引く

f:id:The-Alchemist:20220203133505p:plain

 

 

 

 

 

作業列"h2"から最終行までが範囲です。

 

 

 

 

セルの値がFalseのとき、下記の処理をします。

 

 

 

 

 

 

罫線を引きます。

 

 

 

 

 

 

 

 

 

 

 

 

 

③作業列のクリア

f:id:The-Alchemist:20220203161256p:plain

 

 

 

 

 

 

 

作業列"h2"から最終行までが範囲です。

 

 

 

 

 

 

すべてクリアします。

 

 

 

 

 

コード

①関数の入力

Sub デモ_1() '数式入力
Dim セル範囲 As String, セル As Range, 右下セル As String, 左上セル As String
Sheets("sheet1").Select
'◆最終行を取得し、セル範囲を決める
Range("f2:f2").CurrentRegion.Select
右下セル = Cells(Selection.Row + Selection.Rows.Count - 1, Range("f2").Column).Address(False, False)
セル範囲 = "f2" & ":" & 右下セル 
Range(セル範囲).Select
Call デモ_1_メイン処理(セル範囲, セル)
End Sub

 

Sub デモ_1_メイン処理(セル範囲 As String, セル As Range)
Selection.Offset(0, 2).Formula = "=EXACT(LEFT(A2),LEFT(A3,1))"
End Sub

②罫線を引く

Sub デモ_2() '罫線
Dim セル範囲 As String, セル As Range, 右下セル As String
Sheets("sheet1").Select
'◆最終行を取得し、セル範囲を決める
Range("h2:h2").CurrentRegion.Select
右下セル = Cells(Selection.Row + Selection.Rows.Count - 1, Range("h2").Column).Address(False, False)
セル範囲 = "h2" & ":" & 右下セル
'◆条件分岐
For Each セル In Range(セル範囲).Cells
 If セル.Value = False Then
   セル.Select
   Call デモ_2_メイン処理(セル範囲)
 End If
Next
End Sub

Sub デモ_2_メイン処理(セル範囲 As String)
With Selection.Offset(0, -7).Resize(, 6).Borders(xlEdgeBottom)
 .LineStyle = xlContinuous
 .Weight = xlThick
End With
Selection.Offset(0, -7).Resize(, 6).orders(xlEdgeBottom).Color = RGB(255, 0, 0)
End Sub

③作業列のクリア

Sub デモ_3() 'クリア
Dim セル範囲 As String, セル As Range, 右下セル As String
Sheets("sheet1").Select
'◆最終行を取得し、セル範囲を決める
Range("h2:h2").CurrentRegion.Select
右下セル = Cells(Selection.Row + Selection.Rows.Count - 1, Range("h2").Column).Address(False, False)
セル範囲 = "h2" & ":" & 右下セル
Range(セル範囲).Select
Call デモ_3_メイン処理(セル範囲)
End Sub

Sub デモ_3_メイン処理(セル範囲 As String)
Selection.Clear
End Sub
      

 

 

 

アプリはこちらから↓↓↓↓