• ベストアンサー

最終行の空白セルに右上がり斜線を引く

B列を検索して最終行を選び、C列~G列の中から空白セルを探して、右上がり斜線を引く。 Cells(Rows.Count, 2).End(xlUp).Offset(, 1).Resize(, 5). _ Borders(xlDiagonalUp).LineStyle = xlContinuous データーの入っているセルにも、斜線が引かれてしまいます。 空白セル(変動します)にのみ、斜線を引くことができるようにしたいのです。 よろしくお願いします。

  • 1211M
  • お礼率54% (90/165)

質問者が選んだベストアンサー

  • ベストアンサー
  • tom04
  • ベストアンサー率49% (2537/5117)
回答No.2

こんばんは! 理由はすでにNo.1さんが回答されていらっしゃる通りなので 余計なお世話かもしれませんが・・・ Sub Sample1() Dim endRow As Long, c As Range endRow = Cells(Rows.Count, "B").End(xlUp).Row For Each c In Range(Cells(endRow, "C"), Cells(endRow, "G")) If c = "" Then c.Borders(xlDiagonalUp).LineStyle = xlContinuous End If Next c End Sub こんな感じでもOKだと思います。m(_ _)m

1211M
質問者

お礼

tom04さんご回答いただきありがとうございました。 思い通りにできました。 今後もよろしくお願いします。

その他の回答 (1)

noname#203218
noname#203218
回答No.1

記載されてるマクロはB列の最終行を取得し、そのセルから5列までのセルに斜線を引く事になっています。 セルが空白であるか確認して斜線を引く一例です。ご参考まで。 Sub test() Dim i As Long Dim j As Integer i = Cells(Rows.Count, 2).End(xlUp) For j = 3 To 6 If Cells(i, j) = "" Then Cells(i, j).Borders(xlDiagonalUp).LineStyle = xlContinuous Next End Sub

1211M
質問者

お礼

pidumさんご回答いただきありがとうございました。 思い通りにできました。 今後もよろしくお願いします。

関連するQ&A

  • EXCEL VBA 早く処理をする

    よろしくお願いします 下の構文を標準モジュールに書き込み、callで実行しているのですが 処理に時間がかかります。 処理を早くする方法と構文の簡素化のご教示をお願いします。 Application.ScreenUpdating = False For i = 1 To 12 With Worksheets(i) .Select LastRow = .Range("A150").End(xlUp).Row + 1 .Range("A8:G" & LastRow).Sort Key1:=Range("A8"), order1:=xlAscending .Range("G8:G" & LastRow - 1).Formula = "=G7+E8-F8" LastRow = .Range("A150").End(xlUp).Row + 1 .Range("A" & LastRow).Select Dim EndRow As Long EndRow = .Range("A" & Rows.Count).End(xlUp).Row Cells(Rows.Count, 1).End(xlUp).Offset(1, 3) = .Name & "合計" Cells(Rows.Count, 1).End(xlUp).Offset(1, 4) = Application.WorksheetFunction.Sum(Range("E7:E" & EndRow)) Cells(Rows.Count, 1).End(xlUp).Offset(1, 5) = Application.WorksheetFunction.Sum(Range("F7:F" & EndRow)) Cells(Rows.Count, 1).End(xlUp).Offset(2, 3) = "前月繰越" Cells(Rows.Count, 1).End(xlUp).Offset(2, 4) = .Range("G7") Cells(Rows.Count, 1).End(xlUp).Offset(2, 5) = "" Cells(Rows.Count, 1).End(xlUp).Offset(3, 4) = "" Cells(Rows.Count, 1).End(xlUp).Offset(3, 3) = "次月繰越" Cells(Rows.Count, 1).End(xlUp).Offset(4, 3) = "合計" Cells(Rows.Count, 1).End(xlUp).Offset(3, 5) = Cells(Rows.Count, 1).End(xlUp).Offset(2, 4) + Cells(Rows.Count, 1).End(xlUp).Offset(1, 4) - Cells(Rows.Count, 1).End(xlUp).Offset(1, 5) Cells(Rows.Count, 1).End(xlUp).Offset(4, 4) = Cells(Rows.Count, 1).End(xlUp).Offset(2, 4) + Cells(Rows.Count, 1).End(xlUp).Offset(1, 4) Cells(Rows.Count, 1).End(xlUp).Offset(4, 5) = Cells(Rows.Count, 1).End(xlUp).Offset(3, 5) + Cells(Rows.Count, 1).End(xlUp).Offset(1, 5) Cells(Rows.Count, 1).End(xlUp).Offset(1, 6) = "" Cells(Rows.Count, 1).End(xlUp).Offset(2, 6) = "" Cells(Rows.Count, 1).End(xlUp).Offset(3, 6) = "" Cells(Rows.Count, 1).End(xlUp).Offset(4, 6) = Cells(Rows.Count, 1).End(xlUp).Offset(0, 6) .Range("C7").End(xlDown).Select Selection.Offset(4, 2).Borders(xlEdgeTop).Weight = xlHairline Selection.Offset(4, 2).Borders(xlEdgeBottom).LineStyle = xlDouble Selection.Offset(4, 3).Borders(xlEdgeTop).Weight = xlHairline Selection.Offset(4, 3).Borders(xlEdgeBottom).LineStyle = xlDouble Selection.Offset(4, 4).Borders(xlEdgeTop).Weight = xlHairline Selection.Offset(4, 4).Borders(xlEdgeBottom).LineStyle = xlDouble Selection.Offset(0, 2).Borders(xlEdgeTop).Weight = xlHairline Selection.Offset(0, 2).Borders(xlEdgeBottom).LineStyle = xlContinuous Selection.Offset(0, 2).Borders(xlEdgeBottom).Weight = xlThin Selection.Offset(0, 3).Borders(xlEdgeTop).Weight = xlHairline Selection.Offset(0, 3).Borders(xlEdgeBottom).LineStyle = xlContinuous Selection.Offset(0, 3).Borders(xlEdgeBottom).Weight = xlThin Selection.Offset(0, 4).Borders(xlEdgeTop).Weight = xlHairline Selection.Offset(0, 4).Borders(xlEdgeBottom).LineStyle = xlContinuous Selection.Offset(0, 4).Borders(xlEdgeBottom).Weight = xlThin End With Next i Application.ScreenUpdating = True

  • 【Excel VBA】空白の結合セルに右上り斜線を引く

    Excel VBAは初心者です。 仕事で必要なため、アドバイスをいただけると非常に助かります。 よろしくお願いします。 【VBAで実現したいこと】  下記のようなセルで構成されている簡単な  申請書を作成しております。    結合セル1:ABCD列と4行目で結合されたセルで、氏名を入力します。  結合セル2:EFGH列と4行目で結合されたセルで、氏名を入力します。  結合セルA:ABCD列から5678行で結合されたセルです。  結合セルB:EFGH列から5678行で結合されたセルです。  ※結合セル1、2~10まで存在し、結合セルA、B~Jまで存在します。  結合セルAは結合セル1を参照し、結合セル1が空欄の場合  結合セルAに右上りの斜線を引きます。結合セル1が空欄でない場合、  何もしません。  結合セルBは結合セル2を参照し、結合セル2が空欄の場合  結合セルBに右上りの斜線を引きます。結合セル2が空欄でない場合、  何もしません。  同様な処理を、結合セルJ、結合セル10まで行います。 【教えていただきたいこと】  1.結合セルA~J、結合セル1~10全てが空欄だった場合、   空欄の結合セルは右上りの斜線を引きます。   下記のプログラムを作成しましたが、右上りの斜線が   引けません。   どのようにしたら良いでしょうか。     2.上記「VBAで実現したいこと」を行うためには、   下記のプログラムにどのような追加を行えば良いでしょうか。 【作成したプログラム】 Private Sub worksheet_change(ByVal target As Range) Dim i As Range For Each i In target If i.MergeArea.Value = "" Then i.MergeArea.Borders(xlDiagonalUp).LineStyle = xlContinuous Else i.MergeArea.Borders(xlDiagonalUp).LineStyle = xlNone End If Next i End Sub 以上、よろしくお願いします。

  • エクセルVBA 条件判断(斜線)

    エクセル VBAにて If MasterData(masteridx, 14).Borders(xlDiagonalUp).LineStyle.xlContinuous = Value Then wb.Sheets(Seisannippou & CStr(SHeetNumber)).Range("T12").Borders(xlDiagonalUp).LineStyle = xlContinuous Else wb.Sheets(Seisannippou & CStr(SHeetNumber)).Range("T12").Value = MasterData(masteridx, 14) wb.Sheets(Seisannippou & CStr(SHeetNumber)).Range("T12").Font.Bold = True wb.Sheets(Seisannippou & CStr(SHeetNumber)).Range("T12").Font.Size = 22 End If 以上のようにマスタシート対象品の選択セルが斜線だったら 生産日報シート対象品の選択セルに斜線を記入するようにしたいのですが、If MasterData(masteridx, 14).Borders(xlDiagonalUp).LineStyle.xlContinuous = Value Then wb.Sheets(Seisannippou & CStr(SHeetNumber)).Range("T12").Borders(xlDiagonalUp).LineStyle = xlContinuous の書き込み方(マスタシートの斜線判断)がわかりません。 どのように書き込むのでしょうか?

  • すべてのシートでマクロを実行したい

    以下のプログラムでは、選択したシートのみマクロが動作しています。ネット検索で見よう見まねで作ったため何がまちがっているのかわかりません。ご教示いただけるとありがたいです。 ・月の予定表で利用者が休みの日に斜線を引くマクロ ・入力ミスを防ぐためシート保護をしている Sub すべてのシート() Dim s As Worksheet For Each s In Worksheets s.Select Call 斜線 Next End Sub Sub 斜線() ActiveSheet.Unprotect Password:="1234" For i = 1 To Range("E10").End(xlDown).Row Range("AS" & i).Borders(xlDiagonalUp).LineStyle = xlNone If Range("E10").Value = 0 Then Exit Sub If Cells(i, "E").Value = "日" And Range("BP9").Value = 0 Then Range("AS" & i).Borders(xlDiagonalUp).LineStyle = xlContinuous End If If Cells(i, "E").Value = "月" And Range("BP10").Value = 0 Then Range("AS" & i).Borders(xlDiagonalUp).LineStyle = xlContinuous End If If Cells(i, "E").Value = "火" And Range("BP11").Value = 0 Then Range("AS" & i).Borders(xlDiagonalUp).LineStyle = xlContinuous End If If Cells(i, "E").Value = "水" And Range("BP12").Value = 0 Then Range("AS" & i).Borders(xlDiagonalUp).LineStyle = xlContinuous End If If Cells(i, "E").Value = "木" And Range("BP13").Value = 0 Then Range("AS" & i).Borders(xlDiagonalUp).LineStyle = xlContinuous End If If Cells(i, "E").Value = "金" And Range("BP14").Value = 0 Then Range("AS" & i).Borders(xlDiagonalUp).LineStyle = xlContinuous End If If Cells(i, "E").Value = "土" And Range("BP15").Value = 0 Then Range("AS" & i).Borders(xlDiagonalUp).LineStyle = xlContinuous End If If Cells(i, "AY").Value = "祝日" And Range("BP16").Value = 0 Then Range("AS" & i).Borders(xlDiagonalUp).LineStyle = xlContinuous End If Next i ActiveSheet.Protect Password:="1234" End Sub

  • ワークシートのセルの書式設定の罫線をマクロでひく。

    ワークシートのセルの書式設定の罫線をマクロでひく。 下記マクロを実行すると  (1)のところでBORDERクラスのlinestyle プロパティを設定できません。がでる対策をおしえてください。 Sub Macro1() ' Dim d As Long Sheets("abc").Select '罫線を引く d = Range("A65536").End(xlUp).Row Range("A1", Cells(d, 1)).Select Selection.Borders(xlDiagonalDown).LineStyle = xlNone Selection.Borders(xlDiagonalUp).LineStyle = xlNone With Selection.Borders(xlEdgeLeft) .LineStyle = xlContinuous .Weight = xlThin .ColorIndex = xlAutomatic End With With Selection.Borders(xlEdgeTop) .LineStyle = xlContinuous .Weight = xlThin .ColorIndex = xlAutomatic End With With Selection.Borders(xlEdgeBottom) .LineStyle = xlContinuous .Weight = xlThin .ColorIndex = xlAutomatic End With With Selection.Borders(xlEdgeRight) .LineStyle = xlContinuous .Weight = xlThin .ColorIndex = xlAutomatic End With With Selection.Borders(xlInsideVertical) .LineStyle = xlContinuous  ‘(1) .Weight = xlThin .ColorIndex = xlAutomatic End With With Selection.Borders(xlInsideHorizontal) .LineStyle = xlContinuous .Weight = xlThin .ColorIndex = xlAutomatic End With End Sub

  • エクセルでデータがある部分だけ範囲内の空白も込みで罫線で囲いたいです。

    エクセルでデータがある部分だけ範囲内の空白も込みで罫線で囲いたいです。 再質問です。 エクセルのファイルを開いて、データのある部分だけを罫線で囲みたいです。 データーは常に列数も行数も違います。 また空白の行があったり、列があったり一部のセルが空白だったり。 ここで教えてもらった記述があるのですがその時の質問は (データのある部分だけ囲みたい)としたので、それに対応した記述の為 例えば A1からM1まではデータがあり、 A2からM2までは空白 A3からM3まではデータがある場合とか A1からM100までぎっしり埋まっている場合で E列はE1からE100まで空白とか、 A1からM100までぎっしり埋まっている場合で セルB5、C8、D12、E13だけは空白だと 空白部分は囲ってくれません。 又は A1からM1まではデータがあり、 A2からM2までは空白 A3からM100まではデータがある場合とかだとA1からM1だけ囲まれますが A2からM100までは囲まれません。 これはある意味(データーのある部分だけ)と質問したので仕方有りません。 自分でやるとマクロの記録しかできず以下のようになってしまいます。 これですと上記例でデータはA1からM100までで 3行目がなかったり、D列がなかったり、所々のセルに空白が 有りますが、罫線で囲うのはあくまでA1からM100までなのですが 以下の記述ではシート全てが罫線で囲まれてしまいます。 また対象のファイルは行数や列数が決まっているわけではないのです。 (100行かもしれないし1,000行かも知れない、C列までかも知れないし  Z列までかもしれません。  1から10行までデータがあって100行空白で101行目からまたデータというほど  の空白があるわけでもありません。) どうすれば途中に空白があるデータの先頭から最後だけを囲えるのでしょうか? 空白も対象だとしてしまうとデーターの終わりがわからないから、 シート全部を囲うしかないのでしょうか? Sub Macro1() Cells.Select Selection.Borders(xlDiagonalDown).LineStyle = xlNone Selection.Borders(xlDiagonalUp).LineStyle = xlNone With Selection.Borders(xlEdgeLeft) .LineStyle = xlContinuous .Weight = xlThin .ColorIndex = xlAutomatic End With With Selection.Borders(xlEdgeTop) .LineStyle = xlContinuous .Weight = xlThin .ColorIndex = xlAutomatic End With With Selection.Borders(xlEdgeBottom) .LineStyle = xlContinuous .Weight = xlThin .ColorIndex = xlAutomatic End With With Selection.Borders(xlEdgeRight) .LineStyle = xlContinuous .Weight = xlThin .ColorIndex = xlAutomatic End With With Selection.Borders(xlInsideVertical) .LineStyle = xlContinuous .Weight = xlThin .ColorIndex = xlAutomatic End With With Selection.Borders(xlInsideHorizontal) .LineStyle = xlContinuous .Weight = xlThin .ColorIndex = xlAutomatic End With Range("A1").Select End Sub

  • 表に罫線を最終列まで引きたい

    windows7 とExcel2007でマクロ作成中の初心者です。 最初に、D2:E34を選んで罫線をひき、列を2列移動して、また罫線を引きます。 これをデータのある最終列まで繰り返したいのですが、うまくいきません。 どうしたらよろしいでしょうか。 Sub 勤怠に罫線() Dim n As Integer For n = 1 To 5 勤怠に罫線 Selection.Offset(0, 2).Select 勤怠に罫線 Next n End Sub 以下はマクロの自動記録でコードを書きました。 Sub 勤怠に罫線() Range("D2:E34").Select Selection.Borders(xlDiagonalDown).LineStyle = xlNone Selection.Borders(xlDiagonalUp).LineStyle = xlNone With Selection.Borders(xlEdgeLeft) .LineStyle = xlContinuous .ColorIndex = xlAutomatic .TintAndShade = 0 .Weight = xlMedium End With With Selection.Borders(xlEdgeTop) .LineStyle = xlContinuous .ColorIndex = xlAutomatic .TintAndShade = 0 .Weight = xlMedium End With With Selection.Borders(xlEdgeBottom) .LineStyle = xlContinuous .ColorIndex = xlAutomatic .TintAndShade = 0 .Weight = xlMedium End With With Selection.Borders(xlEdgeRight) .LineStyle = xlContinuous .ColorIndex = xlAutomatic .TintAndShade = 0 .Weight = xlMedium End With Selection.Borders(xlInsideVertical).LineStyle = xlNone Selection.Borders(xlInsideHorizontal).LineStyle = xlNone Range("D2:E34").Select End Sub

  • セルを結合するマクロ

    マクロ初心者です。 Aセルをブランク領域で選択してマクロを実行しますとセルが結合します。 最後の空白がどこまでかは、何か指定がないといけないので、仮にエンドと名付けます。 このコードはA列のみです。A列からM列またはL列までと指定するにはどうすれば良いですか? ご教鞭をお願いします。 Sub test() Set Rng = Range(Cells(1, 1), Cells(Rows.Count, 1).End(xlUp)) Set blanks = Rng.SpecialCells(xlCellTypeBlanks) For Each ar In blanks.Areas Union(ar(1).Offset(-1), ar).Merge Next Cells(Rows.Count, 1).End(xlUp).ClearContents End Sub

  • VBA罫線

    VBA罫線 a = 9 With Range(Cells(3, 2), Cells(a, 5)) .Borders(xlEdgeTop).LineStyle = xlContinuous .Borders(xlEdgeBottom).LineStyle = xlContinuous .Borders(xlEdgeRight).LineStyle = xlContinuous .Borders(xlEdgeLeft).LineStyle = xlContinuous .Borders(xlInsideVertical).LineStyle = xlContinuous .Borders(xlInsideHorizontal).LineStyle = xlContinuous End With どこのワークシートかを指定する場合はどうしたらいいのでしょうか?

  • ,最終行からA1の間に罫線を引く方法は?

    お願いします。 罫線を引くマクロを書きました。(下記) 範囲のJ26は最終行です。この表のデータ量は変化します。 最終行がJ26とは限りません。Z5000かもしれません。 その範囲に罫線をひくのですが、マクロ的に最終行を認知してA1 まで罫線を引くマクロをどう記述すればよいのか教えてください。 Sheets("読み込み").Select Range("A1:J26").Select Range("J26").Activate Selection.Borders(xlDiagonalDown).LineStyle = xlNone Selection.Borders(xlDiagonalUp).LineStyle = xlNone With Selection.Borders(xlEdgeLeft) .LineStyle = xlContinuous .Weight = xlThin .ColorIndex = xlAutomatic End With With Selection.Borders(xlEdgeTop) .LineStyle = xlContinuous .Weight = xlThin .ColorIndex = xlAutomatic End With With Selection.Borders(xlEdgeBottom) .LineStyle = xlContinuous .Weight = xlThin .ColorIndex = xlAutomatic End With With Selection.Borders(xlEdgeRight) .LineStyle = xlContinuous .Weight = xlThin .ColorIndex = xlAutomatic End With With Selection.Borders(xlInsideVertical) .LineStyle = xlContinuous .Weight = xlThin .ColorIndex = xlAutomatic End With With Selection.Borders(xlInsideHorizontal) .LineStyle = xlContinuous .Weight = xlThin .ColorIndex = xlAutomatic End With Range("J3").Select End Sub

専門家に質問してみよう