添付画像の通り左が処理前、右が処理後です。A4セルから下方向に検索していき同じ番号グループでA列からJ列まで、太枠罫線で囲みたいです。なお、A列の入力セル数は任意です。また、このようなシートが20くらいありますので、それぞれで使えるマクロであってほしいです。よろしくお願いします。
該当のセルをアクティブにして実行してください。
Sub Macro() Dim i As Long Dim lastRow As Long Dim stRow As Long With ActiveSheet lastRow = .Cells(Rows.Count, 1).End(xlUp).Row stRow = 4 For i = 4 To lastRow If .Cells(i, 1).Value <> .Cells(i + 1, 1).Value Then With .Range(.Cells(stRow, "A"), .Cells(i, "J")) .Borders(xlEdgeTop).Weight = xlThick .Borders(xlEdgeBottom).Weight = xlThick .Borders(xlEdgeRight).Weight = xlThick .Borders(xlEdgeLeft).Weight = xlThick End With stRow = i + 1 End If Next i End With End Sub
また、20のシートがブックの全てのシートであるなら、こちらで一括でできます。
Sub Macro() Dim i As Long Dim lastRow As Long Dim stRow As Long Dim ws As Worksheet For Each ws In Worksheets With ws lastRow = .Cells(Rows.Count, 1).End(xlUp).Row stRow = 4 For i = 4 To lastRow If .Cells(i, 1).Value <> .Cells(i + 1, 1).Value Then With .Range(.Cells(stRow, "A"), .Cells(i, "J")) .Borders(xlEdgeTop).Weight = xlThick .Borders(xlEdgeBottom).Weight = xlThick .Borders(xlEdgeRight).Weight = xlThick .Borders(xlEdgeLeft).Weight = xlThick End With stRow = i + 1 End If Next i End With Next End Sub
該当のセルをアクティブにして実行してください。
Sub Macro() Dim i As Long Dim lastRow As Long Dim stRow As Long With ActiveSheet lastRow = .Cells(Rows.Count, 1).End(xlUp).Row stRow = 4 For i = 4 To lastRow If .Cells(i, 1).Value <> .Cells(i + 1, 1).Value Then With .Range(.Cells(stRow, "A"), .Cells(i, "J")) .Borders(xlEdgeTop).Weight = xlThick .Borders(xlEdgeBottom).Weight = xlThick .Borders(xlEdgeRight).Weight = xlThick .Borders(xlEdgeLeft).Weight = xlThick End With stRow = i + 1 End If Next i End With End Sub
また、20のシートがブックの全てのシートであるなら、こちらで一括でできます。
Sub Macro() Dim i As Long Dim lastRow As Long Dim stRow As Long Dim ws As Worksheet For Each ws In Worksheets With ws lastRow = .Cells(Rows.Count, 1).End(xlUp).Row stRow = 4 For i = 4 To lastRow If .Cells(i, 1).Value <> .Cells(i + 1, 1).Value Then With .Range(.Cells(stRow, "A"), .Cells(i, "J")) .Borders(xlEdgeTop).Weight = xlThick .Borders(xlEdgeBottom).Weight = xlThick .Borders(xlEdgeRight).Weight = xlThick .Borders(xlEdgeLeft).Weight = xlThick End With stRow = i + 1 End If Next i End With Next End Sub
完璧にできています。感謝です。いつも素早い対応でありがたいです。なお、2つめのコードですが、対象列は現在、2番目のシートから11番目のシートのみです。どのようにしたらいいですか?実は一つ一つやろうと思っていたので、20くらいなんて適当に書いてしまいました。
2番目から11番目なら次ぎのようになります。
7行目が2~11という意味です。
Sub Macro() Dim i As Long Dim lastRow As Long Dim stRow As Long Dim ws As Worksheet Dim j As Integer For j = 2 To 11 With Worksheets(j) lastRow = .Cells(Rows.Count, 1).End(xlUp).Row stRow = 4 For i = 4 To lastRow If .Cells(i, 1).Value <> .Cells(i + 1, 1).Value Then With .Range(.Cells(stRow, "A"), .Cells(i, "J")) .Borders(xlEdgeTop).Weight = xlThick .Borders(xlEdgeBottom).Weight = xlThick .Borders(xlEdgeRight).Weight = xlThick .Borders(xlEdgeLeft).Weight = xlThick End With stRow = i + 1 End If Next i End With Next End Sub
任意のシート1枚を除外するとかなら、そのシートに一時的に空のA列を挿入すればいいです。
はい、すべてできています。素早い回答(解答)ありがとうございました。いつもすみません。
完璧にできています。感謝です。いつも素早い対応でありがたいです。なお、2つめのコードですが、対象列は現在、2番目のシートから11番目のシートのみです。どのようにしたらいいですか?実は一つ一つやろうと思っていたので、20くらいなんて適当に書いてしまいました。