締切済み

エクセルVBA　条件判断（斜線）

2008/04/18 18:18

エクセル　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 の書き込み方（マスタシートの斜線判断）がわかりません。どのように書き込むのでしょうか？

77TAKETAKA
お礼率65% (155/235)

オフィス系ソフト
回答数3
ありがとう数4

みんなの回答 （3）
専門家の回答

みんなの回答

Wendy02
ベストアンサー率57% (3570/6232)

2008/04/28 10:29 回答No.3

#1の回答者です。 >作成プログラムに書き込んでみましたが >　If MasterData(masteridx, 14).Borders(xlDiagonalUp).LineStyle = xlNone Then >の部分で　　実行時エラー'424': >オブジェクトが必要ですその部分にエラーが出るというのは、実際には分かりませんね。全体的には、単に凝った変数を入れただけで、かなり単純なロジックだと思います。同じような繰り返しや変数は、きちんとまとめて入れていけば、もっと分かりやすくなるだろうと思います。例えば、 wb.Sheets(Seisannippou & CStr(SHeetNumber)).Range("T12") このようなコンテナ型で書くなら、それを変数に入れるなり、With ステートメントにしたら、見やすく、より簡単になるだろうと思います。オブジェクトが必要だというのなら、それはそのままの意味ですが、それは、そのコードの前の部分からのつなぎの問題だと思います。また、その部分より前で、何かのコードで、オブジェクトが失っている可能性もあります。なお、もしかしたら、これはコントロールツールのコマンドボタンの内容から抜き出したものでしょうか。あまり、プロシージャから行の抜き出しされると、さっぱり見えないのです。

質問者

お礼 2008/05/08 08:08

何度もアドバイスを頂きありがとうございます。そうですね、凝った変数が使用してあるため見にくい為、徐々に見やすく修正していきます。もう一度最初から動作を確認してオブジェクトの確認してみます。

KenKen_SP
ベストアンサー率62% (785/1258)

2008/04/18 18:56 回答No.2

こんにちは。質問趣旨を勘違いしてるかもしれませんが。　　Dim rSrc As Range 　　Dim rDst As Range 　　　　Set rSrc = Worksheets("Sheet1").Cells(1, "A") 　　Set rDst = Worksheets("Sheet2").Cells(1, "A") 　　rDst.Borders(xlDiagonalUp).LineStyle = _ 　　rSrc.Borders(xlDiagonalUp).LineStyle 罫線を同期させるなら、If による判定は不要に思いました。私見ですが、変数名は短く、またコードの可読性に気を配った方が回答し易いです。例えば、Set ステートメントひとつ使うだけでもご質問前段のコードは非常にすっきりします。　　Dim r As Range 　　　　Set r = wb.Sheets(Seisannippou & CStr(SHeetNumber)).Range("T12") 　　　　If MasterData(masteridx, 14).Borders(xlDiagonalUp).LineStyle = xlContinuous Then 　　　　r.Borders(xlDiagonalUp).LineStyle = xlContinuous 　　Else 　　　　r.Value = MasterData(masteridx, 14) 　　　　r.Font.Bold = True 　　　　r.Font.Size = 22 　　End If ご参考までに。

質問者

お礼 2008/04/28 08:30

御礼が遅くなりましてすみません。前任者が作成したコードをそのまま記載してしまい可読性が悪くてすみません。現状はとりあえず思うように動けばいいと思って作成を行なっていますが上記のように可読性が悪くて修正、追加時に苦労をしております。とても参考になりました。ありがとうございます。

Wendy02
ベストアンサー率57% (3570/6232)

2008/04/18 18:51 回答No.1

こんばんは。この前の続きのような話になりそうですね。 MasterData(masteridx, 14) MasterData は、Range ですね。あまり、このような使い方はしませんね。ご自分で分かっていればよいのですが、これは、相対位置になってしまいますので、かなりややこしくなります。 If MasterData(masteridx, 14).Borders(xlDiagonalUp).LineStyle.xlContinuous = Value Then この部分を含めた以下は、このようにしたら良いと思います。　　With wb.Sheets(Seisannippou & CStr(SHeetNumber)) 　　　　If MasterData(masteridx, 14).Borders(xlDiagonalUp).LineStyle = xlNone Then 　　　　　　.Range("T12").Borders(xlDiagonalUp).LineStyle = xlContinuous 　　　　Else 　　　　　　.Range("T12").Value = MasterData(masteridx, 14) 　　　　　　.Range("T12").Font.Bold = True 　　　　　　.Range("T12").Font.Size = 22 　　　　End If 　　End With

質問者

お礼 2008/04/28 09:03

御礼が遅くなりましてすみません。上記のコード書込参考になりました。作成プログラムに書き込んでみましたが　If MasterData(masteridx, 14).Borders(xlDiagonalUp).LineStyle = xlNone Then の部分で　　実行時エラー'424': オブジェクトが必要です以上のエラーが出てしまいます。どうやら他の部分でエラーを誘発しているようですので現在調べています。色々と参考になることを教えていただきありがとうございます。

関連するQ&A

すべてのシートでマクロを実行したい
以下のプログラムでは、選択したシートのみマクロが動作しています。ネット検索で見よう見まねで作ったため何がまちがっているのかわかりません。ご教示いただけるとありがたいです。・月の予定表で利用者が休みの日に斜線を引くマクロ・入力ミスを防ぐためシート保護をしている 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
- ベストアンサー
- Excel（エクセル）
VBA 　エラー
Sub 上下カット1() Dim MyR As Range, MyMax As Integer, MyMin As Integer Dim MX As Range, MN As Range With ActiveSheet MyMax = WorksheetFunction.Max(.Range("D15:P15")) MyMin = WorksheetFunction.Min(.Range("D15:P15")) For Each MyR In .Range("D15:P15") If MyR.Value = MyMax Then Set MX = MyR If MyR.Value = MyMin Then Set MN = MyR Next MX.Borders(xlDiagonalUp).LineStyle = xlContinuous MN.Borders(xlDiagonalUp).LineStyle = xlContinuous End With With ActiveSheet MyMax = WorksheetFunction.Max(.Range("D16:P16")) MyMin = WorksheetFunction.Min(.Range("D16:P16")) For Each MyR In .Range("D16:P16") If MyR.Value = MyMax Then Set MX = MyR If MyR.Value = MyMin Then Set MN = MyR Next MX.Borders(xlDiagonalUp).LineStyle = xlContinuous MN.Borders(xlDiagonalUp).LineStyle = xlContinuous End With End Sub を実行すると、 MX.Borders(xlDiagonalUp).LineStyle = xlContinuous の部分にエラーがでます。対処方法を教えてください。
- ベストアンサー
- Excel（エクセル）
VBA エラー
Sub 上下カット1() Dim MyR As Range, MyMax As Integer, MyMin As Integer Dim MX As Range, MN As Range With ActiveSheet MyMax = WorksheetFunction.Max(.Range("D15:P15")) MyMin = WorksheetFunction.Min(.Range("D15:P15")) For Each MyR In .Range("D15:P15") If MyR.Value = MyMax Then Set MX = MyR If MyR.Value = MyMin Then Set MN = MyR Next MX.Borders(xlDiagonalUp).LineStyle = xlContinuous MN.Borders(xlDiagonalUp).LineStyle = xlContinuous End With With ActiveSheet MyMax = WorksheetFunction.Max(.Range("D16:P16")) MyMin = WorksheetFunction.Min(.Range("D16:P16")) For Each MyR In .Range("D16:P16") If MyR.Value = MyMax Then Set MX = MyR If MyR.Value = MyMin Then Set MN = MyR Next MX.Borders(xlDiagonalUp).LineStyle = xlContinuous MN.Borders(xlDiagonalUp).LineStyle = xlContinuous End With End Sub を実行すると”オブジェクト変数またはWithブロック変数が設定されていません。”と出ます。どうしたらいいですか？
- ベストアンサー
- Excel（エクセル）
エクセルで条件付きで罫線の斜線を引きたいです。
エクセル2007についての質問です。ある条件のときに罫線の右下がり斜線を引きたいのですが、条件付書式ではできません。マクロでしなくてはいけないことはわかったのですが、それ以上は進めなくて困っています。セル（U2)に数字を打ち込んだらセル（I10:J11),(I12:J13),(I14:J15),(L10:Q11)，(L12:Q13），(L14:Q15)（結合したもの）にIF関数とINDEX関数を組み合わせて他のシートからセル（U2)に対応するデーターを呼び出しています。セル（I10:J11)に呼び出した数値が10未満ならセル(L10:Q11)に罫線で右下がりの斜線を入れ、10以上なら右下がりの斜線を消すということが行いたいです。（他の2つの組み合わせでも同様） 3年前に同じ質問をさせていただき、 Private Sub Worksheet_SelectionChange(ByVal Target As Range) If Range("I10").Value < 10 Then Range("L10:Q11").Borders(xlDiagonalDown).LineStyle = xlContinuous Else Range("L10:Q11").Borders(xlDiagonalDown).LineStyle = xlNone End If End Sub という解答をいただき、解決したのですが、マクロの起動は、シート内でセルの移動で実行されていました。今回はいくつものデータを呼び出しながら印刷を一括で行うマクロと同時に使用することになり、印刷中はシート内のセルの移動ができません。何とかならないものかなぁと模索中ですが、皆さまからお力をいただけないかと思っております。よろしくお願いします。
- ベストアンサー
- Visual Basic
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 どこのワークシートかを指定する場合はどうしたらいいのでしょうか？
- ベストアンサー
- その他（プログラミング・開発）
EXCEL 異なるVBA
教えて下さい、EXECL以下の異なるVBA (A>,B>)が２つあります、同じシートでそれぞれ動くようにさせたいです1つに合わせる事は出来ないでしょうか? 当方初心者の為わかりません教えて下さい。 A> Private Sub Worksheet_Change(ByVal Target As Excel.Range) If Target.Address(0, 0, xlA1, 0) <> "A1" Then Exit Sub With Range("F9:I9,K17:K36").Borders(xlDiagonalUp) If Left$(Target.Value, 1) = "S" Then .LineStyle = xlContinuous .Weight = xlThin .ColorIndex = xlAutomatic Else .LineStyle = xlNone End If End With End Sub B> Private Sub Worksheet_Change(ByVal Target As Range) With Sheet2 Select Case Target.Address Case Is = "$D$1" .Range("A1").Insert Shift:=xlDown .Range("A1").Value = Target.Value Case Is = "$D$2" .Range("B1").Insert Shift:=xlDown .Range("B1").Value = Target.Value End Select End With End Sub
- 締切済み
- その他([技術者向] コンピューター)
エクセルのVBAについて教えてください！
VBAの初心者です。罫線に関するマクロで、以下のようなマクロを作りました。このマクロを改造して、外枠全体に関して同じことができるようにしたくていろいろ試してみたのですが、どうしてもできません。非常に初歩的な質問で申し訳ありませんが、よろしくお願い致します。 Sub 罫線右() With Selection If .Borders(xlEdgeRight).LineStyle = xlNone Then .Borders(xlEdgeRight).LineStyle = xlContinuous Exit Sub End If If .Borders(xlEdgeRight).LineStyle = xlContinuous And .Borders(xlEdgeRight).Weight = xlThin Then .Borders(xlEdgeRight).Weight = xlHairline Exit Sub Else .Borders(xlEdgeRight).LineStyle = xlNone End If End With End Sub
- 締切済み
- Visual Basic
エクセルVBA　行列の数を指定して罫線を引くマクロ教えてください
下のようにSheet1に罫線を引く「開始セル(左右端)」「行」「列」が書いてあります。この条件で罫線をSheet2に引くようにしたいのですが、変数の設定の仕方などが分かっていないようで、できません。教えていただけないでしょうか。マクロの記録をとったところ、下のようになりました。よろしくお願いします。開始セル Sheet2!A1・・・Sheet1のB1セル行 8・・・Sheet1のB2セル列 2・・・Sheet1のB3セル Sub borders() Range("A1:B8").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 End Sub
- ベストアンサー
- オフィス系ソフト
Ｏｆｆｉｃｅ2007でＶＢＡの実行が遅くなる？
普段Office2000を使っているのですが、新しくOffice2007の入ったパソコンが導入されて、以前に作ったマクロを走らせてみたのですが、なぜか処理が非常に重くなります。何か仕様変更か何かで、文法やルールが変わったとかあるのでしょうか？ちなみに問題のマクロは以下の通りです。 Sub 空白セルに右下がりの斜線() 　'選択したすべてのセルに対して、データがnullだった場合、　'右下がりの斜線を引きます。　Dim r As Range 　'選択範囲の斜線をクリア　Selection.Borders(xlDiagonalDown).LineStyle = xlNone 　If TypeName(Selection) = "Range" Then 　　For Each r In Selection 　　　If r.Value = "" Then 　　　　With r.Borders(xlDiagonalDown) 　　　　　.LineStyle = xlContinuous 　　　　　.Weight = xlHairline 　　　　　.ColorIndex = xlAutomatic 　　　　End With 　　　End If 　　Next r 　End If End Sub ちなみにOffice2000では正常に動きます。（それ以外のバージョンではためしていません。）
- ベストアンサー
- その他MS Office製品
エクセルマクロ VBA 罫線文字列
職場で使う表をVBAマクロを用いて罫線作成をしています。前任者のアレンジを頼まれたのですが前任者に連絡が取れず困っています。表の特徴は以下のようになります。・A列を飛ばし、B列から2列飛びで文字を記入・b2＝曜日、b3＝1、b4＝2、b5＝3、b6＝4、b7＝空白のセットが曜日ごとに2セット×7日分この表を・b2＝曜日、b3＝-3、b4＝-2、b5＝-1、b6＝0、b7＝1、b8＝2、b9＝3、b10＝4、b11＝空白のセットが曜日ごとに2セット×7日分に変更したいのですが空欄の場所がずれてしまい上手くいきません。原本のマクロは以下です。 ---------------------------------------------------------------- Sub 罫線作成() Range(Cells(4, 1), Cells(86, 22)).Select Selection.Borders(xlDiagonalDown).LineStyle = xlNone Selection.Borders(xlDiagonalUp).LineStyle = xlNone Selection.Borders(xlEdgeLeft).LineStyle = xlNone Selection.Borders(xlEdgeTop).LineStyle = xlNone Selection.Borders(xlEdgeBottom).LineStyle = xlNone Selection.Borders(xlEdgeRight).LineStyle = xlNone Selection.Borders(xlInsideVertical).LineStyle = xlNone Selection.Borders(xlInsideHorizontal).LineStyle = xlNone ch1 = "月火水木金土日" For i = 4 To 76 Step 12 n1 = (i + 8) \ 12 Range(Cells(i, 1), Cells(i + 10, 22)).Select With Selection.Borders(xlEdgeLeft) .LineStyle = xlContinuous .Weight = xlMedium .ColorIndex = xlAutomatic End With With Selection.Borders(xlEdgeTop) .LineStyle = xlContinuous .Weight = xlMedium .ColorIndex = xlAutomatic End With With Selection.Borders(xlEdgeBottom) .LineStyle = xlContinuous .Weight = xlMedium .ColorIndex = xlAutomatic End With With Selection.Borders(xlEdgeRight) .LineStyle = xlContinuous .Weight = xlMedium .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 'Cells(i, 1) = Mid(ch1, n1, 1) For i2 = 2 To 20 Step 3 For i3 = i To i + 10 nb1 = (i3 + 8) Mod 12 If nb1 = 0 Or nb1 = 6 Then Cells(i3, i2) = Mid(ch1, n1, 1) If nb1 = 1 Or nb1 = 7 Then Cells(i3, i2) = 1 If nb1 = 2 Or nb1 = 8 Then Cells(i3, i2) = 2 If nb1 = 3 Or nb1 = 9 Then Cells(i3, i2) = 3 If nb1 = 4 Or nb1 = 10 Then Cells(i3, i2) = 4 Next Next Next End Sub ---------------------------------------------------------------- 4行目から142行目まで使用することは分かっているのですが… どうかご助力お願いします。
- ベストアンサー
- オフィス系ソフト

エクセルVBA　条件判断（斜線）