Excel VBAについてのマクロのエラー解決方法

このQ&Aのポイント
  • VBA初心者がExcelでマクロを作成しようとしたが、エラーが発生してうまくいかない。
  • マクロの目的は、黄色で塗られたセルの右隣のセルに「○」を表示すること。
  • エラーの原因を特定し、適切な修正方法を教えてほしい。
回答を見る
  • ベストアンサー

excel vbaについてです

VBA初心者で、暇な時にいろいろためしています。 以下のマクロを組んだのですが、エラーがでてうまくいきません。 どこがいけないのかご指摘願います。 Sub ather() Dim A As Range Dim B As Range Dim i As Integer With ThisWorkbook.Worksheets("Sheet1") For i = 1 To 30 Set A = Cells(i, 1) Set B = Cells(1, i) If Not .Range(A).Interior.ColorIndex = vbYellow Then GoTo port10 If Not .Range(B).Interior.ColorIndex = vbRed Then GoTo port10 .Range(B).Offset(, 1).Value = "○" port10: Next i End With End Sub イメージとしてはセルの塗りつぶしが黄色で、かつ右隣のセルの塗りつぶしが赤の時に、 赤色セルの右隣のセルに○を表示させようとしているのですが。。。 こうしたらいいんじゃない?といったアドバイスもお願いします(-人-)

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

  • ベストアンサー
  • qualheart
  • ベストアンサー率41% (1451/3486)
回答No.1

いくつか間違いがありますね。 まず、 Set A = Cells(i, 1) Set B = Cells(1, i) は間違いです。 これだと、Cells(i, 1)とCells(1, i)のセルに入っている値をAとBに代入してしまっているので、 Range(Cells(i, 1)の値)となってしまっているのでもちろんエラーになります。 また、Rangeの使い方ですが、Rangeは二つ以上のセルを含む範囲ではないとエラーになります。 つまりRange(Cells(i, 1))はエラーになってしまうと言うことです。 ひとつのセルを参照するなら、そのままCells(i.1)のみで良いです。 あと「セルの塗りつぶしが黄色で、かつ右隣のセルの塗りつぶしが赤」ということは 一つ目のセルがCells(i, 1)だとすると、その右隣のセルはCells(i, 2)になります。 Cells(1, i)じゃ全然違うセルを参照してしまいます。 あともう一つ、vbYellowやvbRedと一致させたいなら、ColorIndexではなくColorプロパティを使用する必要があります。 これらを総合すると、 Sub ather() Dim i As Integer With ThisWorkbook.Worksheets("Sheet1") For i = 1 To 30 If Not .Cells(i, 1).Interior.Color = vbYellow Then GoTo port10 If Not .Cells(i, 2).Interior.Color = vbRed Then GoTo port10 .Cells(i, 3).Value = "○" port10: Next i End With End Sub でOKということになります。 ご参考まで。

その他の回答 (1)

  • keithin
  • ベストアンサー率66% (5278/7940)
回答No.2

マクロのご相談では,「どこ番地のセル」をキチンと明記します。 >イメージとしてはセルの塗りつぶしが黄色で、かつ右隣のセルの塗りつぶしが赤の時に、 A1:A30の範囲で,黄色のセルについて 隣のB列のセルが赤だったら 隣のC列のセルに○を記入する マクロにも幾つか間違いがあります。 参考にしてください: sub macro1()  dim i as integer  worksheets("Sheet1").select  for i = 1 to 30   if cells(i, "A").interior.color = vbyellow then    if cells(i, "B").interior.color = vbred then     cells(i, "C") = "○"    end if   end if  next i end sub

関連するQ&A

  • ExcelのVBAで質問です。

    以下のようなシートがあります。 A列  B列  C列  D列  E列  F列  G列  H列 NO  名前  確認 日付1 日付2  確認 日付1 日付2 6行目からデータを入れる予定です。 C列には○印を入力します。 C列~E列までデータが入った行は、 F列~H列まで同じ処理をします。 (セルの背景色を変えます。) 以後同じことを列方向で繰り返します。 以下のようなVBAを組みましたが、 ○の個数を数える部分でエラーがでます。 Private Sub Worksheet_Change(ByVal Target As Range) Dim staff As String Dim kakunin As String Dim date1 As Date Dim date2 As Date Dim i As Long Dim j As Long Dim cnt As Long '100件分ループ For i = 6 To 105 '○の数をカウント cnt = WorksheetFunction.CountIf(ActiveSheet.Range(Cells(i, 2), Cells(i, 256)), "○") 'jとは確認の列番号のこと j = 3 * cnt staff = Cells(i, 2) kakunin = Cells(i, j) date1 = Cells(i, j + 1) date2 = Cells(i, j + 2) 'スタッフ名が入力されたら If staff = "" Then Range(Cells(i, j), Cells(i, j + 50)).Interior.ColorIndex = 15 Else Cells(i, j).Interior.ColorIndex = xlNone '○が入力されたら If kakunin = "○" Then Range(Cells(i, j + 1), Cells(i, j + 2)).Interior.ColorIndex = xlNone Else Range(Cells(i, j + 1), Cells(i, j + 2)).Interior.ColorIndex = 15 End If If Cells(i, j + 1) <> "" And Cells(i, j + 2) <> "" Then Cells(i, j + 3).Interior.ColorIndex = xlNone End If End If Next i End Sub ご教授いただけたら、幸いです。 よろしくお願いいたします。

  • エクセル VBA セルの色をSheet1とSheet2の両方を変えたいのですが・・・

    最近困っているところが表題の通りなのですが Sheet1のB2を右クリックするとB2のセルの色を変えて Sheet2のB2のセルも色を変えたいというものです。 現状で Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean) Dim Rng As Range, myRng As Range Dim RngA As Range, myRngA As Range Set Rng = Range("B3:W3,b7:w8,b12:w12,d13:w13,d17:w18,d22:w23") Set myRng = Intersect(Target, Rng) If myRng.Interior.ColorIndex = xlColorIndexNone Then myRng.Interior.ColorIndex = 37 Else If myRng.Interior.ColorIndex = 37 Then myRng.Interior.ColorIndex = 45 Else myRng.Interior.ColorIndex = xlColorIndexNone End If End If Cancel = True End Sub とここまではあるのですが、これをどう改造すればSheet2の同じセルの色もかわるのでしょうか? 宜しくお願いいたします

  • エクセル VBA 検索 スクロール

    お世話になります。 A列に製品名、B列に場所と詳細を表した表です。 E1に製品名を入れて検索ボタンを押すと右隣のセルの値がE1に表示され検索件数がMsgBoxに表示されるものをこのページで聞いたりしながら作りました。 'Dim 対象セル As Range 'Dim 最初のセル番地 As String 'Dim 検索件数 As Long Cells.Interior.ColorIndex = xlNone If Range("E1").Value = "" Then Exit Sub Set 対象セル = Range("A2:A1287").Find(What:=Range("E1").Value, After:=Range("A1287"), lookAt:=xlWhole) If 対象セル Is Nothing Then Exit Sub 最初のセル番地 = 対象セル.Address Do 対象セル.Interior.ColorIndex = 37 検索件数 = 検索件数 + 1 Set 対象セル = Range("A2:A1287").FindNext(対象セル) Loop While 対象セル.Address <> 最初のセル番地 Range("E3").Value = 対象セル.Offset(, 1).Value MsgBox "検索件数は" & 検索件数 & " 件です" End Sub Private Sub Worksheet_SelectionChange(ByVal Target As Range) End Sub 今回質問したいのは検索したセルを含む行(製品名によって複数あります)を自動で一番上、A5でウィンドウの固定をしてあるのでA6からの表示になるようにスクロールするにはどのようにしたらいいでしょうか?よろしくお願いします。

  • この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

  • VBAで教えてください。

    以前ここで教えていただいたVBAで http://jisaku.155cm.com/src/1371930716_9b9006528605642980beed48a8998013b0731e4b.jpg のようにA列のテスト4をクリックしたときにC列のテスト4が一発で解るようにしたいです。 もちろん、テスト11をクリックしたときは、テスト4塗りつぶしは解除され、 テスト11が塗りつぶされるようにしたいです。 写真は塗りつぶししていますが、解るようにしたいだけなので、塗りつぶしにはこだわっていません。 あと、E、F、G列は解りやすく並べているだけで、実際はA、B、C列だけです。 それと、C列は関数を使って表示してあります。 という質問で Private Sub Worksheet_SelectionChange(ByVal Target As Range) 'この行から Dim i As Long Range("C:C").Interior.ColorIndex = xlNone If Application.Intersect(Target, Range("A:A")) Is Nothing Or Target.Count <> 1 Then Exit Sub On Error Resume Next Application.ScreenUpdating = False ActiveSheet.Cells.interio.ColorIndex = xlNone For i = 1 To Cells(Rows.Count, 1).End(xlUp).Row If Cells(i, "C") = Target Then Cells(i, "C").Interior.ColorIndex = 3 End If Next i Application.ScreenUpdating = True End Sub 'この行まで をシートのコードに張り付ければいいですよ。と教えてくれたものがあるのですが、 A列でクリックした文字をC列からすべて見つけて反転してくれないようです。何個か反転してくれない ものが出てきてしまいました。 C列が何百行とかなってしまうと、すべての同じ文字を検索してくれないのでしょうか? ちなみに列がここに掲載しているものと違うので Private Sub Worksheet_SelectionChange(ByVal Target As Range) 'この行から Dim i As Long Range("R:R").Interior.ColorIndex = xlNone If Application.Intersect(Target, Range("B:B")) Is Nothing Or Target.Count <> 1 Then Exit Sub On Error Resume Next Application.ScreenUpdating = False ActiveSheet.Cells.interio.ColorIndex = xlNone For i = 1 To Cells(Rows.Count, 1).End(xlUp).Row If Cells(i, "R") = Target Then Cells(i, "R").Interior.ColorIndex = 3 End If Next i Application.ScreenUpdating = True End Sub 'この行まで のCをRにAをBに変更して使ってます。 これがいけないのかな? よろしくお願いします。

  • エクセル マクロ 複数セルの色付けについて

    マクロ初心者で苦戦しており、教えていただけると大変ありがたいです。 エクセルの複数のシートに、問2_1 、問2_2 、問2_10 (全部で問は2_28まであります)等の文字列があり、その文字に合わせて、そのセルだけ色を付けたいと考えております。 今書いているコードだと、ワークシートのA列にある場合は色が付けられるのですが、それ以外に色が付けられません。どこが間違っているでしょうか? どうぞご指導お願いいたします。 Sub 色つけ() Dim Maxrow As Long Dim i As Long Maxrow = Cells(Rows.Count, i).End(xlUp).Row For i = 1 To Maxrow If InStr(Cells(i, 1), "2_1 ") > 0 Then Cells(i, 1).Interior.ColorIndex = 6 If InStr(Cells(i, 1), "2_2 ") > 0 Then Cells(i, 1).Interior.ColorIndex = 6 If InStr(Cells(i, 1), "2_23 ") > 0 Then Cells(i, 1).Interior.ColorIndex = 23 If InStr(Cells(i, 1), "2_13 ") > 0 Then Cells(i, 1).Interior.ColorIndex = 4 If InStr(Cells(i, 1), "2_6 ") > 0 Then Cells(i, 1).Interior.ColorIndex = 7 Next i End Sub

  • EXCEL VBA2010 MsgBox

    Sub 重複() Dim i As Long, j As Long For i = 6 To 500 For j = 3 To 3 If WorksheetFunction.CountIf(Range("C6:C500"), Cells(i, j)) > 1 Then Cells(i, j).Interior.ColorIndex = 6 End If Next j Next i End Sub このVBAに重複が何件ありますよというメッセージを出したいです。 MsgBoxの入れ方を教えてください。

  • エクセルマクロで教えてください

    マクロ初心者です。アドバイスをお願いします。以下のマクロですとB列の100行目までの塗りつぶしのセルのカウントは出来るのですが、シート上の全てをカウントしたいのです。1TO 100の100の部分をどう変更したら良いのか教えてください。 Sub セルの色数1() Dim I As Integer Dim Count As Integer Count = 0 For I = 1 To 100 If Cells(I, 2).Interior.ColorIndex <> xlNone Then Count = Count + 1 Next I Range("C1").Value = Count End Sub

  • VBAでの計算後のセルに2重線で囲む

    まだPC・VBA不慣れな為、実行できないので、教えてください。 c16セルに休日を入力すると無理つぶしは成功しましたが、c16セルに祭日を入力すると赤の2重線で囲みたいのですが、できませんので、方法をお願いします。 もう1点がCELLS・RANGEを使った2種類の方法をお願いします。 よろしくお願いします。 Sub 練習44() Dim kyuyo As Currency If Range("c16").Value = "祭日" Then Worksheets("練習1If~Then").Cells(16, 3).xlDouble.ColorIndex = 3 ElseIf Range("c16").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

  • EXCEL VBAの配列でわかりません。

    こんなコードがあるのですが、最後の他のシート(作業中シート)に書き込もうとするとエラーになってしまいます。”Sheets("作業中").”を抜くと同じシートに結果は返ってくるのですが…。コードの内容は、ある範囲のある列から空白ではないセルを探し出してその行のデータを配列で汲み取り、他のシートに一括で洗い出すというものです。 Sub 作業中() Dim myRow As Long Dim Data As Variant Dim WC() As Variant Dim WCE() As Variant myRow = Range("H1").CurrentRegion.Rows.Count Data = Range("H1:M" & myRow).Value For i = 1 To myRow If Data(i, 5) <> "" Then a = a + 1 Else b = b + 1 End If Next ReDim WC(a) ReDim WCE(b) c = 0 d = 0 For i = 1 To myRow If Data(i, 5) <> "" Then WC(c) = Range("H" & i & ":K" & i).Value c = c + 1 Else WCE(d) = Range(Cells(i, 8), Cells(i, 11)).Value d = d + 1 End If Next For i = 0 To a Range(Cells(i + 1, 15), Cells(i + 1, 18)).Value = WC(i) Next For i = 0 To b Range(Cells(i + 1, 19), Cells(i + 1, 22)).Value = WCE(i) Next e = Range(Cells(1, 15), Cells(a, 18)).Value Sheets("作業中").Range(Cells(1, 1), Cells(a, 4)).Value = e End Sub ちなみに同じシートから↓のコードを実行するとうまくいきます。 なぜ~??わからな~い??おしえてくださーい!! Sub test() Dim a As Variant a = Range("H1:K4") Sheets("作業中").Range("N1:Q4") = a End Sub

専門家に質問してみよう