VBA 実行時エラー1004　について

2023/09/06 09:29

このQ&Aのポイント

VBA 実行時エラー1004　Rangeメソッドは失敗しました。GlobalオブジェクトというエラーがIf Range(Cells(5, n - 4)).Interior.Color = RGB(252, 213, 180) Thenのところででます。If Range("Z5").Interior.Color = RGB(252, 213, 180) Thenとすると、実行できます。
Sub カラー() Dim n As Long '列番号取得最終列取得 n = Cells(5, Columns.Count).End(xlToLeft).Column MsgBox "最終列は" & n　　'＝　今回は30です。 'セルの色を変える If Range(Cells(5, n - 4)).Interior.Color = RGB(252, 213, 180) Then Range(Cells(3, n - 3), Cells(5, n)).Interior.Color = RGB(230, 184, 183) Range(Cells(39, n - 3), Cells(41, n)).Interior.Color = RGB(230, 184, 183) Range(Cells(68, n - 3), Cells(70, n)).Interior.Color = RGB(230, 184, 183) Range(Cells(104, n - 3), Cells(106, n)).Interior.Color = RGB(230, 184, 183) Range(Cells(133, n - 3), Cells(135, n)).Interior.Color = RGB(230, 184, 183) Range(Cells(169, n - 3), Cells(171, n)).Interior.
Color = RGB(230, 184, 183) Range(Cells(198, n - 3), Cells(200, n)).Interior.Color = RGB(230, 184, 183) Range(Cells(234, n - 3), Cells(236, n)).Interior.Color = RGB(230, 184, 183) Range(Cells(263, n - 3), Cells(265, n)).Interior.Color = RGB(230, 184, 183) Range(Cells(299, n - 3), Cells(301, n)).Interior.Color = RGB(230, 184, 183) Range(Cells(329, n - 3), Cells(331, n)).Interior.Color = RGB(230, 184, 183) Range(Cells(365, n - 3), Cells(367, n)).Interior.Color = RGB(230, 184, 183) Else Range(Cells(3, n - 3), Cells(5, n)).Interior.Color = RGB(252, 213, 180) Range(Cells(39, n - 3), Cells(41, n)).Interior.

ベストアンサー

VBA 実行時エラー1004　について

2015/11/27 10:31

いつもお世話になります。作表をしていて、項目に色をつけたいのですが VBA 実行時エラー1004　Rangeメソッドは失敗しました。Globalオブジェクトというエラーが If Range(Cells(5, n - 4)).Interior.Color = RGB(252, 213, 180) Then のところででます。 If Range("Z5").Interior.Color = RGB(252, 213, 180) Then とすると、実行できます。 Sub カラー() Dim n As Long '列番号取得 '最終列取得 n = Cells(5, Columns.Count).End(xlToLeft).Column MsgBox "最終列は" & n　　　'＝　今回は30です。 'セルの色を変える If Range(Cells(5, n - 4)).Interior.Color = RGB(252, 213, 180) Then Range(Cells(3, n - 3), Cells(5, n)).Interior.Color = RGB(230, 184, 183) Range(Cells(39, n - 3), Cells(41, n)).Interior.Color = RGB(230, 184, 183) Range(Cells(68, n - 3), Cells(70, n)).Interior.Color = RGB(230, 184, 183) Range(Cells(104, n - 3), Cells(106, n)).Interior.Color = RGB(230, 184, 183) Range(Cells(133, n - 3), Cells(135, n)).Interior.Color = RGB(230, 184, 183) Range(Cells(169, n - 3), Cells(171, n)).Interior.Color = RGB(230, 184, 183) Range(Cells(198, n - 3), Cells(200, n)).Interior.Color = RGB(230, 184, 183) Range(Cells(234, n - 3), Cells(236, n)).Interior.Color = RGB(230, 184, 183) Range(Cells(263, n - 3), Cells(265, n)).Interior.Color = RGB(230, 184, 183) Range(Cells(299, n - 3), Cells(301, n)).Interior.Color = RGB(230, 184, 183) Range(Cells(329, n - 3), Cells(331, n)).Interior.Color = RGB(230, 184, 183) Range(Cells(365, n - 3), Cells(367, n)).Interior.Color = RGB(230, 184, 183) Else Range(Cells(3, n - 3), Cells(5, n)).Interior.Color = RGB(252, 213, 180) Range(Cells(39, n - 3), Cells(41, n)).Interior.Color = RGB(252, 213, 180) Range(Cells(68, n - 3), Cells(70, n)).Interior.Color = RGB(252, 213, 180) Range(Cells(104, n - 3), Cells(106, n)).Interior.Color = RGB(252, 213, 180) Range(Cells(133, n - 3), Cells(135, n)).Interior.Color = RGB(252, 213, 180) Range(Cells(169, n - 3), Cells(171, n)).Interior.Color = RGB(252, 213, 180) Range(Cells(198, n - 3), Cells(200, n)).Interior.Color = RGB(252, 213, 180) Range(Cells(234, n - 3), Cells(236, n)).Interior.Color = RGB(252, 213, 180) Range(Cells(263, n - 3), Cells(265, n)).Interior.Color = RGB(252, 213, 180) Range(Cells(299, n - 3), Cells(301, n)).Interior.Color = RGB(252, 213, 180) Range(Cells(329, n - 3), Cells(331, n)).Interior.Color = RGB(252, 213, 180) Range(Cells(365, n - 3), Cells(367, n)).Interior.Color = RGB(252, 213, 180) End If End Sub どこが間違っているのか教えていただけないでしょうか？あと、スマートなコードの書き方もお願いします。

kisaragijec
お礼率46% (30/64)

Excel（エクセル）
回答数4
ありがとう数6

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

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

ベストアンサー

real beatin（@realbeatin）
ベストアンサー率82% (174/211)

2015/11/27 12:00 回答No.3

こんにちは。 > どこが間違っているのか教えていただけないでしょうか？まず、直接の対策として、エラー箇所は、 If Cells(5, n - 4).Interior.Color = RGB(252, 213, 180) Then のようにします。 Range(Cells(y1, x1), Cells(y2, x2))のように、２つのセルを起終点として指定する使い方は正しいですが、 > Range(Cells(5, n - 4)) のように、Range()の内側の引数は、 Cells()を単独で指定することはできませんから、 Range()を無しにして　Cells(5, n - 4) のように指定してやれば良いです。 > あと、スマートなコードの書き方もお願いします。 ' ' /// Sub ReW9086872a() Dim n As Long　'　列番号取得 Dim nColor As Long, nColor2 As Long 　　' ' 最終列取得　　n = Cells(5, Columns.Count).End(xlToLeft).Column 　　MsgBox "最終列は" & n　　　'＝　今回は30です。　　' ' 基準になる色を指定　　nColor1 = RGB(252, 213, 180) 　　' ' 新たに塗り潰す色を指定　　If Cells(5, n - 4).Interior.Color = nColor Then nColor = RGB(230, 184, 183) 　　' ' 新たに塗り潰すセル範囲を指定して、、、塗りつぶし。　　Application.Intersect( _ 　　　　Range("3:5,39:41,68:70,104:106,133:135,169:171,198:200,234:236,263:265,299:301,329:331,365:367"), _ 　　　　Cells(n - 3).Resize(, 4).EntireColumn _ 　　　　　　).Interior.Color = nColor End Sub ' ' /// 「同じような記述を繰り返さない」「同じ様な記述の中で変わる部分を変数にする」というような事を心掛けると好い、という風に、私も初学の頃に教わりました。今回の場合は、塗り潰すセル範囲は固定ですから、色の方を変数に収めれば、記述の繰り返しをなくせます。塗り潰すセル範囲の捉え方だけ、内側から順に説明してみます。１）　　Range("3:5,39:41,68:70,104:106,133:135,169:171,198:200,234:236,263:265,299:301,329:331,365:367") 　　　　3:5行、39:41行、68:70行、、、365:367行、指定した複数ブロックの行を一纏めに参照します。　　　　Range("3:5,39:41,68:70,104:106,133:135,169:171,198:200,234:236,263:265,299:301,329:331,365:367").Select 　　　　などを実行して試してみて下さい。２）　　Cells(n - 3).Resize(, 4).EntireColumn 　　　　Cells(n - 3)で、n-3列 1行めのセルを指します。→（n=30なら）Cells(1,27)＝Range("AA1") 　　　　.Resize(, 4)で、直前に指定したセル範囲の横方向のサイズを4列分に変更します。→（n=30なら）Range("AA1:AD1") 　　　　.EntireColumnで、直前に指定したセル範囲を列全体に拡張します。→（n=30なら）Range("AA:AD") ３）　　Application.Intersect(range1, range2) 　　　　という書式で、「複数のセル範囲の共有セル範囲を表す Range オブジェクトを返します。」　　　　１）２）に共通するセル範囲を返します。→（n=30なら）AA3:AD5,AA39:AD41,AA68:AD70, .... ,AA365:AD367 ４）　　.Interior.Color = nColor 　　　　３）までで指定したセル範囲の塗りつぶしを変数nColorに変更します。不明、不足があれば補足欄にでも書いてみて下さい。以上です。

質問者

お礼 2015/12/01 11:35

realbeatinさん、いつも丁寧に教えていただきありがとうございます。 RangeとCellsの書き方の違い、よくわかりました。コードをコピーして、適当に変更して作成していると、初歩的なことが抜けているんですね。マクロが動くと、つい、理解できた気になっていたのですが。。。今回のコードも今は解ったつもりなのですが、応用するときにまた悩むかもしれません。その時はまた、よろしくお願いします。ありがとうございました。

その他の回答 (3)

real beatin（@realbeatin）
ベストアンサー率82% (174/211)

2015/11/27 12:35 回答No.4

No.3です。失礼しました。誤って編集課程の方のマクロをあげてしまったようですので、差し替えをお願いします。 ' ' /// Sub ReW9086872a() Dim n As Long　'　列番号取得 Dim nColor As Long　'　塗りつぶし色　　' ' 最終列取得　　n = Cells(5, Columns.Count).End(xlToLeft).Column 　　MsgBox "最終列は" & n　　　'＝　今回は30です。　　' ' 基準になる色を指定　　nColor = RGB(252, 213, 180) 　　' ' 新たに塗りつぶす色を指定　　If Cells(5, n - 4).Interior.Color = nColor Then nColor = RGB(230, 184, 183) 　　' ' 新たに塗りつぶすセル範囲を指定して、、、塗りつぶし。　　Application.Intersect( _ 　　　　Range("3:5,39:41,68:70,104:106,133:135,169:171,198:200,234:236,263:265,299:301,329:331,365:367"), _ 　　　　Cells(n - 3).Resize(, 4).EntireColumn _ 　　　　　　).Interior.Color = nColor End Sub ' ' ///

ushi2015
ベストアンサー率51% (241/468)

2015/11/27 11:42 回答No.2

こんにちは Sub test() Dim n As Long Dim i As Long Dim c As Long '最終列取得 n = Cells(5, Columns.Count).End(xlToLeft).Column MsgBox "最終列は" & n '＝　今回は30です。 If Cells(5, n - 4).Interior.Color = RGB(252, 213, 180) Then c = RGB(230, 184, 183) Else c = RGB(252, 213, 180) End If With Cells(3, n - 3).Resize(3, 4) For i = 0 To 4 .Offset(65 * i).Interior.Color = c .Offset(36).Offset(65 * i).Interior.Color = c Next i = 5 .Offset(65 * i + 1).Interior.Color = c .Offset(36).Offset(65 * i + 1).Interior.Color = c End With End Sub こんな感じも。

質問者

お礼 2015/11/30 11:17

ushi2015さま、ありがとうございます。大変勉強になりました。これからもよろしくお願いいたします。

dogs_cats
ベストアンサー率38% (278/717)

2015/11/27 11:19 回答No.1

一例です。 Sub カラー() Dim n, i As Long '列番号取得 Dim ColNo As Variant Dim myRGB As String ColNo = Array(3, 39, 68, 104, 133, 169, 198, 234, 263, 299, 329, 365) '最終列取得 n = Cells(5, Columns.Count).End(xlToLeft).Column MsgBox "最終列は" & n '＝　今回は30です。 'セルの色指定 If Cells(5, n - 4).Interior.Color = RGB(252, 213, 180) Then myRGB = RGB(230, 184, 183) Else myRGB = RGB(252, 213, 180) End If 'セルの色変更 For i = 0 To UBound(ColNo) Range(Cells(ColNo(i), n - 3), Cells(ColNo(i) + 2, n)).Interior.Color = myRGB Next i End Sub 最大列からセル色範囲を指定していますが、セル色の列が毎回変動するなら前回指定の色を塗りつぶし無しにしなくて良いのか、気になるところです。 If Range(Cells(5, n - 4)).Interior.Color = RGB(252, 213, 180) Then セル１つだけを参照していますので、rangeは不用で、 If Cells(5, n - 4).Interior.Color = RGB(252, 213, 180) Then colnoという一次配列に行番号を格納しています。 arrayを使用していますので要素番号は0から開始されます。 UBound(ColNo)で変数colnoの一次配列要素数を取得しています。要素番号は0から開始されるので11という数値を取得します。（12ケの数値でfor~nextは実施します) array http://www.officepro.jp/excelvba/array/index6.html UBound http://officetanaka.net/excel/vba/function/UBound.htm

質問者

お礼 2015/11/30 09:55

dogs_cats さま、ありがとうございました。この表は、毎月2回作成するのですが、1回につき、4列作成するだけなので比較できるように、前回の右に追加するようにしました。作成する度に、項目の色を交互にしていくため、塗りつぶし無しにはしていません。（ちょっとカラフルすぎかもしれませんね）コードはとても勉強になりました。配列はまったく理解できていないので、これから勉強したいとおもいます。 Dim n, i As Long これも、勉強になりました。ありがとうございました。

関連するQ&A

エクセルVBAで複数シートにマクロ実行
エクセル2000です。 Sub 行列非表示() For i = 2 To 120 If Cells(i, "A").Interior.ColorIndex = 3 Then Cells(i, "A").EntireRow.Hidden = True End If Next i For n = 1 To 50 If Cells(1, n).Interior.ColorIndex = 3 Then Cells(1, n).EntireColumn.Hidden = True End If Next n End Sub 上記マクロを、シートAAAとCCCとEEEに実行する場合、 Sub test() Sheets("AAA").Activate Call 行列非表示 Sheets("CCC").Activate Call 行列非表示 Sheets("EEE").Activate Call 行列非表示 End Sub と書くよりももっとすっきり実行する方法は無いでしょうか？各シートの非表示対象の行や列はそれぞれことなります。また　Sub 行列非表示自体も、もっと効率的にやる方法はないでしょうか？
- ベストアンサー
- オフィス系ソフト
Excel VBA Interior.Color
困っています。よろしくお願いします。以下のマクロで、値として「薄緑」（13172680）を入力したのに、その値が勝手に変わってしまいます。 13434828になってってしまいます。そのため、「色消し」が働きません。また、colorとして「白」（16777215）を設定した場合と、colorindexとしてxlnoneを入力した場合、excelの表上での見た目が違います。なぜでしょうか。また、colorに何を入力するとcolorindexにxlnoneを入力したのと同じになるのでしょうか。 Option Explicit Public Const 薄緑 As Long = 13172680 '200,255,200 Public Const 白 As Long = 16777215 'rgb(255,255,255) Sub 色付け() 　Cells(1, 1).Interior.Color = 薄緑 End Sub Sub 色消し() 　　　If Cells(1, 1).Interior.Color = 薄緑 Then 　　　Cells(1, 1).Interior.Color = 白　　　End If End Sub Sub test() 　　　Cells(1, 1).Interior.ColorIndex = xlNone End Sub Sub test1() 　　　Cells(1, 1).Interior.Color = 白 End Sub Sub test2() 　　　MsgBox Cells(1, 1).Interior.Color End Sub
- ベストアンサー
- Visual Basic
実行時エラー13　型が一致しません。エラー2029
エクセルです。 A1に「=a」と文字が入っていて、 #NAME? となります。その状態でvbaでセルA1に「=a」が入っているのならとしたい為、 Sub test() If Cells(1, 1) = "=a" Then End If End Sub こうしたのですが、実行時エラー13　型が一致しません。になります。ｖｂａ中断中に、Cells(1, 1)の部分にマウスカーソルを当ててみるとエラー　2029　となっています。 If Cells(1, 1) = "=a" Then が無理なら、 If Cells(1, 1) = "#NAME?" Then なら行けるかな？と思いましたが、全く同じエラーになります。最終的に何がやりたいかと言うと、 Sub test() If Cells(1, 1) = "=a" Then Rows(1).delele End If End Sub のように、#NAME?の場合は、その行を削除したいです。
- ベストアンサー
- Excel（エクセル）
エクセルマクロFor Eachを1回で処理したい
エクセル2013です。以下のようなマクロを作成しました。 For Each が2回、回る為、処理時間が長いです。 For Each を１かいで済ませたくif文をandでつなげばといろいろ試しましたが、うまくできません。 For Each を１回で済ませるにはどうすればいいでしょうか？よろしくお願いします。 Sub 出荷済削除() Dim 対象セル As Range Dim 対象色 As Long Dim 対象色2 As Long Dim 最終行 Dim 最終列最終列 = Cells(8, Columns.Count).End(xlToLeft).Column '8行目の最終列を取得最終行 = Cells(Rows.Count, 1).End(xlUp).Row 'A列の最終行を取得 Application.ScreenUpdating = False '画面切替停止対象色 = Range("B8").Interior.Color 'セルB8の色を基準色とする For Each 対象セル In Range(Cells(10, 17), Cells(最終行, 最終列)) If 対象セル.Interior.Color = 対象色 Then 対象セル.ClearContents '基準色と同じ色のセルの値をクリアする Next 対象セル対象色2 = Range("A8").Interior.Color 'セルB8の色を基準色とする For Each 対象セル In Range(Cells(10, 17), Cells(最終行, 最終列)) If 対象セル.Interior.Color = 対象色2 Then 対象セル.ClearContents '基準色と同じ色のセルの値をクリアする Next 対象セル Application.ScreenUpdating = True '画面切替停止解除 End Sub
- ベストアンサー
- Excel（エクセル）
このコードですが、うまく実行できません！
EXEL 2002　です。最終シートに　「約40行」　ぐらいのデータがあり、　　その各行の列に、　約20個の数値のセルがあり、　　　その各セルの数値が　3　以上だったら、　「.Offset(38, 0)」セルを赤色にする。を、全部の　「約40行」　に実行したいと思っております。下記コードなのですが、　うまくできません、　3行目がエラーとなります。何卒、ご教示よろしくお願い致します。 ------------------------- Sub 数値3以上なら上方セルを赤色にする() Dim r As Range With Worksheets(Worksheets.Count) For Each r In .Range("A40", .Range("A65536").End(xlUp)) If r.Offset(0, 1).Resize(, r.Offset(0, 1).Range("IV40").End(xlToLeft)).Cells.Value >= 3 Then r.Offset(38, 0).FormatConditions(1).Interior.ColorIndex = 3 '赤に塗りつぶす End If Next r End With End Sub
- ベストアンサー
- オフィス系ソフト
VBA実行時のエラー
下記のプログラムは私が作った物では無いのですが、作った方と連絡をとる事が出来なくなってしまった為、質問させて頂きます。このプログラムをシートから実行した所エラー：400『既にフォームは表示されています。モーダルにできません。』なるものが表示されてしまいます。またコードを記述する所から実行しますと実行時エラー：１００４『アプリケーション定義またはオブジェクト定義のエラー』となってしまいます。私の努力が足りないのは重々承知ですが、解決する事が出来ません。皆様のお力を借りることが出来たらと思い投稿しました。宜しくお願い致します。 Sub syoutotumen() Dim i As Long Dim j As Long Dim k As Long Dim kyori As Long Dim n As Integer n = 1 i = 1 j = 1 k = 1 Const cnsYEN = "\" Dim xlAPP As Application Dim objWBK As Workbook Dim strPATHNAME As String Dim strFILENAME As String strPATHNAME = "C:\Documents and Settings\tata41\デスクトップ\画像処理\" If strPATHNAME = "" Then Exit Sub strFILENAME = Dir(strPATHNAME & "dem******", vbNormal) If strFILENAME = "" Then MsgBox "このフォルダにはExcelワークブックは存在しません" Exit Sub End If Set xlAPP = Application With xlAPP .ScreenUpdating = False .EnableEvents = Fales .EnableCancelKey = xlErrorHandler .Cursor = xlWait End With Set WS1 = Worksheets("sheet1") Range("A1") = "0" Range("A2") = "1" Range("A1:A2").Select Selection.AutoFill Destinaton:=Range("A1:A512") Do While strFILENAME <> "" DoEvents If swESC = True Then If MsgBox("ESCが押されました。ここで終了しますか？", vbInformation + vbYesNo) = vbYes Then GoTo Button1_Click_Exit Else swESC = False End If End If xlAPP.StatusBar = trFILENAME & "処理中..." Set objWBK = Workbooks.Open(Filename:=strPATHNAME & cnsYEN & strFILENAME, UpdateLinks:=False, ReadOnly:=True) Do If Cells(i, 2) = 255 Then Exit Do i = i + 1 Loop Do If Cells(j, 3) = 255 Then Exit Do j = j + 1 Loop Do If Cells(k, 4) = 255 Then Exit Do k = k + 1 Loop kyori = (i + j + k - 21) / 3 WS1.Cells(n, 2) = kyori n = n + 1 i = 1 j = 1 k = 1 objWBK.Close savechanges:=False strFILENAME = Dir Loop GoTo Button1_Click_Exit Button1_Click_ESC: If Err.Number = 18 Then swESC = True Resume ElseIf Err.Number = 1004 Then Resume Next Else MsgBox Err.Description End If Button1_Click_Exit: With xlAPP .StatusBar = False .ScreenUpdating = True .EnableEvents = True .EnableCancelKey = xlInterrupt .Cursur = xlDefault Set objWBK = Nothing Set xlAPP = Nothing End With End Sub
- ベストアンサー
- オフィス系ソフト
エクセルマクロFor Eachの処理が長い
エクセル2013です。皆さんに教えていただいて以下のマクロが完成しました。サンプルデータ３０行、7列ではあっという間に処理ができたのですが本番環境 800行、50列ですと処理時間が長く青丸がくるくる回っていて、2分後にくらいで終わります。もう少し早く処理する方法はありますでしょうか？ Findで検索して、一括削除？（それはマクロでできるのでしょうか？）よろしくお願いします。 Sub 出荷済削除() Dim 対象セル As Range Dim 対象色 As Long Dim 対象色2 As Long Dim 最終行 Dim 最終列最終列 = Cells(8, Columns.Count).End(xlToLeft).Column '8行目の最終列を取得最終行 = Cells(Rows.Count, 1).End(xlUp).Row 'A列の最終行を取得 Application.ScreenUpdating = False '画面切替停止対象色 = Range("B8").Interior.Color 'セルB8の色を基準色とする対象色2 = Range("A8").Interior.Color 'セルB8の色を基準色とする For Each 対象セル In Range(Cells(10, 17), Cells(最終行, 最終列)) If 対象セル.Interior.Color = 対象色 Or 対象セル.Interior.Color = 対象色2 Then 対象セル.ClearContents Next 対象セル Application.ScreenUpdating = True '画面切替停止解除 End Sub
- ベストアンサー
- Excel（エクセル）
このVBAソースのどこが間違ってるか教えてください
Dim csp As Integer 'ストップ Dim css As Integer 'ストップorスタート Sub Quest2() If css = 0 Then css = 1 Quest2a Else cstp = 1 css = 0 End If End Sub Sub Quest2a() Sheets("Sheet1").Select Range("B1:J10").Select Selection.Interior.ColorIndex = x1None Range("a1").Select cstp = 0 Do r = 1: c = 5 For i = 0 To 15 If i < 9 Then Cells(r, c).Interior.ColorIndex = x1None r = r + 1 If i < 5 Then c = c + 1 Else c = c - 1 End If Cells(r, c).Interior.ColorIndex = 3 Else Cells(r, c).Interior.ColorIndex = x1None r = r - 1 If i < 13 Then c = c - 1 Else c = c + 1 End If Cells().Interior.ColorIndex = 3 End If 'タイミング For tm1 = 1 To 1000: For tm2 = 1 To 100: Next If cstp = 1 Then Exit For End If Next DoEvents If cstp = 1 Then Exit For End If If r = 3 And c = 5 Then Cells(r, c).Interior.ColorIndex = x1None End If Next DoEvents If cstp = 1 Then Exit Do End If Loop Cells(10, 9) = Cells(r, c) Cells(10, 9).Interior.ColorIndex = 8 End Sub
- ベストアンサー
- その他（プログラミング・開発）
ＶＢＡでの計算後のセルに２重線で囲む
まだＰＣ・ＶＢＡ不慣れな為、実行できないので、教えてください。ｃ１６セルに休日を入力すると無理つぶしは成功しましたが、ｃ１６セルに祭日を入力すると赤の２重線で囲みたいのですが、できませんので、方法をお願いします。もう１点がＣＥＬＬＳ・ＲＡＮＧＥを使った２種類の方法をお願いします。よろしくお願いします。 Sub 練習44() Dim kyuyo As Currency If Range("ｃ16").Value = "祭日" Then Worksheets("練習1If～Then").Cells(16, 3).xlDouble.ColorIndex = 3 ElseIf Range("ｃ16").Value = "休日" Then Worksheets("練習1If～Then").Cells(16, 3).Interior.ColorIndex = 5 Else Worksheets("練習1If～Then").Cells(16, 3).Interior.ColorIndex = 10 End If End Sub
- ベストアンサー
- Visual Basic
ファイルオープン時のマクロが一部実行されない
いつも回答して頂き、ありがとうございます。感謝感謝です。ファイルオープン時にApplication.Runで３つのマクロを実行させているのですが、最後のマクロだけ実行されません。どうしてでしょうか？もしかして、前の２つで『一覧シート』を除外するマクロを実行しているからでしょうか？御指導の程宜しくお願いいたします。 1番目に実行するマクロ Sub 特定のシート以外の最終履歴と次回予定日を算出する() Dim ws As Worksheet For Each ws In Worksheets If ws.Name <> "一覧" Then If ws.Name <> "メニュー" Then Dim c As Integer c = 3 Do While ws.Cells(2, c).Value <> "" With ws.Cells(6, c) .FormulaR1C1 = "=MAX(R8C:R10000C)" If .Value = 0 Then .Value = "履歴無し" ws.Cells(7, c).ClearContents Else .Value = .Value ws.Cells(7, c) = DateAdd("d", ws.Cells(5, c), DateAdd("m", ws.Cells(4, c), DateAdd("yyyy", ws.Cells(3, c), ws.Cells(6, c)))) End If End With c = c + 1 Loop End If End If Next End Sub ２番目に実行するマクロ Sub 期限の未達と到達を色で分ける() Dim ws As Worksheet For Each ws In Worksheets If ws.Name <> "一覧" Then If ws.Name <> "メニュー" Then Dim c As Long Dim res As Variant For c = 3 To ws.Cells(7, Columns.Count).End(xlToLeft).Column If IsDate(ws.Cells(7, c)) Then If ws.Cells(7, c) > Date Then res = 8 Else res = 3 End If Else res = xlNone End If ws.Cells(7, c).Interior.ColorIndex = res Next c End If End If Next End Sub ３番目に実行するマクロ Sub 各シートの情報を一覧へ転記する() Dim d As Integer Dim retu As Integer d = 3 Do While Cells(d, 2).Value <> "" With Worksheets(Worksheets("一覧").Cells(d, 2).Value) .Activate retu = .Range("IV7").End(xlToLeft).Column .Range(Cells(7, 3), Cells(7, retu)).Copy End With With Worksheets("一覧") .Activate Cells(d, 3).PasteSpecial Paste:=xlPasteAllExceptBorders, Operation:=xlNone, _ SkipBlanks:=False, Transpose:=False Application.CutCopyMode = False End With d = d + 1 Loop End Sub
- ベストアンサー
- オフィス系ソフト

VBA 実行時エラー1004　について

VBA 実行時エラー1004　について