「★」というシートの中のA2から下に向かって項目が並んでいます。
B2から下も同様に項目が並んでいます。
B列のセルの文字列にカタカナの「メ」が含まれていた場合、その行のAのセルに、
外枠太羅線をつけたいのです。
例
B5のセル内に「メ氏名」、B8のセルに「メ注」などとあったら、A5、A8のセルの外枠
が太くなります。
A列のセルの中身が1つでも空白になったら、マクロがとまります。
上記なるべく簡単なコードでお願いできますでしょうか?
お手数ですがよろしくお願いします。
全角または半角の「メ」に反応するようになっています。
枠は黒の太実線です。
Option Explicit Sub main() Dim r As Integer Dim str As String Worksheets("★").Select For r = 1 To Range("A1").End(xlDown).Row str = Cells(r, 2).Value If (InStr(str, "メ") > 0 Or InStr(str, "メ") > 0) Then Cells(r, 1).BorderAround LineStyle:=xlContinuous, Weight:=xlThick, Color:=RGB(0, 0, 0) End If Next r End Sub
一例
Option Explicit Sub Macro1() ' 定数 Const sheetname = "★": '対象シート Const searchKeyward = "メ": '検索キーワード Const lineWeight = xlThick: '線の太さ(太xlThick/中xlMedium/細xlThin) Const lineColor = xlAutomatic: '線の色(自動) ' Const lineColor = 3: '線の色(赤) Sheets(sheetname).Select With ActiveSheet '罫線を全部クリア Columns("A:A").Select With Selection .Borders(xlDiagonalDown).LineStyle = xlNone .Borders(xlDiagonalUp).LineStyle = xlNone .Borders(xlInsideVertical).LineStyle = xlNone .Borders(xlInsideHorizontal).LineStyle = xlNone .Borders(xlEdgeLeft).LineStyle = xlNone .Borders(xlEdgeTop).LineStyle = xlNone .Borders(xlEdgeBottom).LineStyle = xlNone .Borders(xlEdgeRight).LineStyle = xlNone End With .Range("A2").Select Do While Selection.Value <> "" With Selection If InStr(searchKeyward, .Offset(0, 1).Value) > 0 Then With .Borders(xlEdgeLeft) .LineStyle = xlContinuous .Weight = lineWeight .ColorIndex = lineColor End With With .Borders(xlEdgeTop) .LineStyle = xlContinuous .Weight = lineWeight .ColorIndex = lineColor End With With .Borders(xlEdgeBottom) .LineStyle = xlContinuous .Weight = lineWeight .ColorIndex = lineColor End With With .Borders(xlEdgeRight) .LineStyle = xlContinuous .Weight = lineWeight .ColorIndex = lineColor End With End If .Offset(1, 0).Select End With Loop End With '終了メッセージ MsgBox "終了しました" End Sub
ご指摘感謝します
おっしゃるとおり逆でした
>If InStr(searchKeyward, .Offset(0, 1).Value) > 0 Then
>ではなく
>If InStr(.Offset(0, 1).Value,searchKeyward) > 0 Then
全クリアと、ボーダースタイルの一括指定は、どちらがいいか迷うところですが、
マクロ記録で記録される方式が判りやすいかなと思って今回はベタな方式にしてます
いずれにしてもBorderAroundは環境依存度が高いので避けますけどね
ありがとうございました!直したほうでできました。MOOKさんもまたぜひ回答をお願いしますね。(過去どれだけお世話になっているか・・・本当に助かりまくっております)
全角または半角の「メ」に反応するようになっています。
枠は黒の太実線です。
Option Explicit Sub main() Dim r As Integer Dim str As String Worksheets("★").Select For r = 1 To Range("A1").End(xlDown).Row str = Cells(r, 2).Value If (InStr(str, "メ") > 0 Or InStr(str, "メ") > 0) Then Cells(r, 1).BorderAround LineStyle:=xlContinuous, Weight:=xlThick, Color:=RGB(0, 0, 0) End If Next r End Sub
ありがとうございました!コードも短くて助かりました。
ありがとうございました!コードも短くて助かりました。
2011/12/24 16:00:34