宜しくお願いいたします。急いでるのですが列がA2か

質問

宜しくお願いいたします。急いでるのですが列がA2からAJまであり、行がA2からA4000まであるのですが、対象となるのはB列に例えば日産とかのようにメーカー名前が、記載されてます。メーカー名前には他に色々なメーカーが記載されてるのですが、メーカー名ごとに区切りのところに太線で区切りたいのです。列は先程のかさAJのところまで太線で区切りたいのです。マクロで教えてください。宜しくお願いいたします

回答No.1

kagakusuki · ベストアンサー

>行がA2からA4000まであるのですが

との事ですが、B2に入力されているのは

>日産とかのようにメーカー名前

なのでしょうか、それとも「メーカー名」などと言ったその列の項目名なのでしょうか？
　その事に関して御質問文には何も説明が御座いませんので、取り敢えずB2には「メーカー名」などと言ったその列の項目名が入力されている場合に関して回答させて頂きます。
　その場合、下記の様なマクロでは如何でしょうか。

Sub QNo9118473_宜しくお願いいたします_急いでるのですが列がA2か()

Const ItemRow = 2 '表の中で項目名が入力されている行の行番号
Const ListColumns = "A:AJ" '表の罫線が引かれている列の範囲
Const SearchColumn = "B" '表の中でメーカー名が入力されている列の列番号
Dim c As Range, LastRow As Long

LastRow = Range(SearchColumn & Rows.Count).End(xlUp).row
If LastRow <= ItemRow Then
MsgBox "処理すべきデータがありません。" & vbCrLf _
& "マクロを終了します。", vbExclamation, "データ無し"
Exit Sub
End If

Application.ScreenUpdating = False

For Each c In Range(SearchColumn & ItemRow + 1 _
& ":" & SearchColumn & LastRow)
If c.Value <> c.Offset(1).Value Then _
Intersect(c.Resize(2, 1).EntireRow, Range(ListColumns)) _
.Borders(xlInsideHorizontal).Weight = xlThick
Next c

Application.ScreenUpdating = True

End Sub

お礼

ご回答ありがとうございます。すごすぎます。驚きました。完了しました。ありがとうございました。

回答No.2

Prome_Lin

鈍くさいマクロですので、多分、No.1の回答の方がいいと思います（確かめていませんが）。

一応、説明しておきます。

「Ｂ２」の内容を変数「ａ」に入れます。

「Ｂ３」から「Ｂ最終行」まで１つずつ読み込んで
「ａ」の値と違った場合、その行の上に太い線を引きます。

「ａ」の内容を、新たな内容に変更します。

これをコツコツと最後まで繰り返しています。

Sub Borders()
Dim a As String
Dim b As Object
Dim i As Integer
a = Range("B2").Value
For i = 3 To Cells(Rows.Count, 2).End(xlUp).Row
If Cells(i, 2).Value <> a Then
Set b = Range(Cells(i, 1), Cells(i, 36)).Borders(xlEdgeTop)
b.LineStyle = xlContinuous
b.Weight = xlThick
a = Cells(i, 2).Value
End If
Next
End Sub