• ベストアンサー

マクロよ動け

VBA 難民です。 Excel で、左のセルが空白の場合、印刷文字を見えなくするつもりのマクロを作ってみましたが、知らん顔をされます。声の掛け方がまだよくわかってないのです。 こっちを向かせる方法を教えて下さい。よろしくお願いします。 Sub MacroWhiter() Dim a As Variant Dim b As Variant a = ActiveCell.Value b = ActiveCell.Offset(0, -1).Value '一つ左のセルの値 Range("B1").Activate 'ここから始める Do Until IsEmpty(ActiveCell.Value) '空きセルまで続ける If b = 0 Then 'ゼロの場合 ActiveCell.Font.Color = 2 '文字を白色にする ActiveCell.Offset(1, 0).Activate '下の行に移る End If Exit Do Loop '繰り返す a = ActiveCell.Value

  • awazo
  • お礼率97% (616/629)

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

  • ベストアンサー
  • ASIMOV
  • ベストアンサー率41% (982/2351)
回答No.2

いくつか、問題点がありました 1.Exit Do のためにループが1回しか回らない 2.a,b の取得がループ内に無いので、終了判定が出来ない 3.カラーの設定方法の間違い ------------------ Sub MacroWhiter() Dim a As Variant Dim b As Variant Range("B1").Activate 'ここから始める Do Until IsEmpty(ActiveCell.Value) '空きセルまで続ける   a = ActiveCell.Value   b = ActiveCell.Offset(0, -1).Value '一つ左のセルの値   If b = 0 Then 'ゼロの場合     ActiveCell.Font.ColorIndex = 2 '文字を白色にする   End If   ActiveCell.Offset(1, 0).Activate '下の行に移る Loop '繰り返す End Sub

awazo
質問者

お礼

ASIMOVさん ありがとうございました。 教えていただいたとおり修正したらうまくいきました。

その他の回答 (2)

  • Wendy02
  • ベストアンサー率57% (3570/6232)
回答No.3

こんにちは。 他のみなさんが、回答してくれるので、あまり重複する内容は避けたいと思いますが、VBAの基礎では、何かの教本などに当てはめるようにして作ったほうがよいです。 それと、私も経験があるのですが、このような実践のレベルから入ると、マクロはさっぱり分かりづらくなるように思います。近道のようで遠回りになります。 なお、Activate と Select の若干のスピードの違いがあるようです。 また、Do ~ Loop も、For i =1 to ● ~ Next を経験された後のほうがよいと思います。 以下の「私のマクロ」のレベルは、VBAの学習を効率よくやって、だいたい2週間過ぎたぐらいです。(「私のマクロ」とも書かないと、とんでもない誤解した人がいますから、あくまでも、私の書いたもののみです。なお、実践では、With ActiveSheet ~ End With で、.Cells(...) という書き方にします。) 'Option Explicit Sub TestMacro() 'Cell's color changes to white color Dim i As Long Dim LastRow As Long 'C列の最後尾の行数を探す LastRow = Range("C65536").End(xlUp).Row '画面の更新をオフにします。 Application.ScreenUpdating = False For i = 1 To LastRow   If Cells(i, 2).Value = 0 Then  'B列(2列目)のセルが0 なら、    Cells(i, 2).Font.ColorIndex = 2 '白に   End If Next i Application.ScreenUpdating = True End Sub

awazo
質問者

お礼

Wendy02さん ありがとうございます。 むずかしいですね。 ScreenUpdatingというのを初めて知りました。

  • bitsu
  • ベストアンサー率34% (39/113)
回答No.1

こんにちわ。 文字色を変えるところの記述がたぶんまずいと思います。 Selection.Font.ColorIndex = 2 '文字を白色にする と書いたら動きませんかね?

awazo
質問者

お礼

bitsuさん ありがとうございます。 ColorIndexプロパティの"Index"が抜けていました。 Font.Color = 2 と書いた参考書もあったのですが。 参考書も2冊比べると全く違うことが書いてあったり、あまりあてになりませんね。

関連するQ&A

  • Excelマクロ:変数でセル範囲指定

    マクロの迷い人です。 Excelの表をマクロで印刷しようと思っています。 行の数が毎回違うため、最終セルもその都度指定しなければなりません。 A1 B1 A2 B2 A3 B3 A4 B4 この例で、A5 B5 以降は空セルとします。 印刷範囲を Range("A1:B4")と書かずに、そのときどきのアクティブセルを変数に代入し、変数を使って範囲指定したいのです。 Sub MacroTest () Dim a As Variant Dim b As Variant Range("B1").Activate Do While a <> 0 ActiveCell.Offset(1, 0).Activate '空白でなければ一つ下に移る a = ActiveCell.Value Loop ActiveCell.Offset(-1, 0).Activate '上の行に移る b = ActiveCell.Value Range("A1:"& b).Select End Sub こうしてみましたがダメでした。 デバッグの方法がわからないので教えて下さい。よろしくお願いします。

  • マクロでテーターを転記した時の空白なしに

    いつもお世話になります。 WINDOWS7 EXCEL2010 です。 添付図で説明させていただきますと、 右側の「請求書」のL5:O9 のデーターを左の「売上表」に下記のマクロにて転記します。 元の値(請求書 L5:O9)の範囲内のデーターが1行 2行 3行 4行は空白行が又は5行の場合はすべてが埋まったりします。 この場合5行の時はいいのですが、例えばデーターが3行の時は添付図で言いますと5の行6の行のように2行が空白になります。 下記のマクロの構文をどういう具合にすればいいか御指導願えませんでしょうか。 参考に、 L5 =IF(B15="","",B15) M5 =IF(L5="","",$A$2) N5 =IF(L5="","",C15) O5 =IF(L5="","",H15) ※ 下記のようにしたかったのですがそれ程詳しくないのと時間がないので上記のような方法になり少し遠回りです。 ‘Range("B1").Select ‘ActiveCell.Offset(1, 0).Activate マクロです。 Sub 売上表へ転記() Dim ID As Long Dim 納品日 As Date ID = Range("M5").Value 日付 = Range("L5").Value Range("L5:O9").Copy Sheets("売上表").Activate Range("A65536").End(xlUp).Activate '販売記録A2がアクティブセル(タイトル行) ActiveCell.Offset(1, 0).Activate ActiveCell.PasteSpecial Paste:=xlPasteValues Application.CutCopyMode = False 'A2:E2 ActiveCell.Offset(0, 4).Activate 'C2が空白 Do Until ActiveCell.Offset(2, 0).Value = "" ActiveCell.Value = ID 'G2 ActiveCell.Offset(0, 0).Value = 納品日 'A3 ActiveCell.Offset(1, 0).Activate Loop End Sub

  • マクロでテーターを転記した時の空白なしに

    いつもお世話になります。 WINDOWS7 EXCEL2010 です。 添付図で説明させていただきますと、 右側の「請求書」のL5:O9 のデーターを左の「売上表」に下記のマクロにて転記します。 元の値(請求書 L5:O9)の範囲内のデーターが1行 2行 3行 4行は空白行が又は5行の場合はすべてが埋まったりします。 この場合5行の時はいいのですが、例えばデーターが3行の時は添付図で言いますと5の行6の行のように2行が空白になります。 下記のマクロの構文をどういう具合にすればいいか御指導願えませんでしょうか。 参考に、 L5 =IF(B15="","",B15) M5 =IF(L5="","",$A$2) N5 =IF(L5="","",C15) O5 =IF(L5="","",H15) ※ 下記のようにしたかったのですがマクロに詳しくないのと時間がないので上記のような方法になり少し遠回りです。 ‘Range("B1").Select ‘ActiveCell.Offset(1, 0).Activate マクロです。 Sub 売上表へ転記() Dim ID As Long Dim 納品日 As Date ID = Range("M5").Value 日付 = Range("L5").Value Range("L5:O9").Copy Sheets("売上表").Activate Range("A65536").End(xlUp).Activate '販売記録A2がアクティブセル(タイトル行) ActiveCell.Offset(1, 0).Activate ActiveCell.PasteSpecial Paste:=xlPasteValues Application.CutCopyMode = False 'A2:E2 ActiveCell.Offset(0, 4).Activate 'C2が空白 Do Until ActiveCell.Offset(2, 0).Value = "" ActiveCell.Value = ID 'G2 ActiveCell.Offset(0, 0).Value = 納品日 'A3 ActiveCell.Offset(1, 0).Activate Loop End Sub

  • 行方向の同じ値のセルを結合するマクロ

    ネットで色々調べながら、A列方向の同じ値のセルを結合させるマクロ を作ってみたのですが、もっと簡単にできるようでしたら教えていただきたいです。 どうぞよろしくお願いいたします。 Sub セル結合() Dim r As Integer '行数 Dim i As Integer 'カウンタ r = Sheets(1).Range("a1").CurrentRegion.Rows.Count - 1 Application.DisplayAlerts = False For i = 1 To r Cells(i, 1).Activate '項目の一つ下のセルをアクティブに If ActiveCell.Value = ActiveCell.Offset(1).Value Then Range(ActiveCell, ActiveCell.Offset(1)).Merge End If Next Application.DisplayAlerts = True End Sub

  • A2の値がA1の値と同じ場合はB2にB1の値+1をして

    A2の値がA1の値と同じ場合はB2にB1の値+1をして A2の値がA1の値と違う場合はB2に"1"を繰り返しさせて入力するように 以下としたのですが、A列の値がなくなる限り1が入力されるだけなのですが どうすれば、A列のセルに同じ値が続く場合連番とすることができるでしょうか。お願いします。 range("B1").value = 1 range("B2").select dim 番号 As varient 番号 = activecell.offset(-1, -1).value do until activecell.offset(0,-1).value = "" with activedell if offset(0, -1).value = 番号 then offset(0, 0).value = offset(-1, 0).value + 1 end if offset(0, 0).value = "1" offset(1, 0).select end with loop

  • VBAについて

    いつもお世話になっています マクロ・VBA超初心者です。 質問させてください。 現在シート1の完売のセルの欄に○が入っていれば日付をみてシート2の同じ日付の隣のセルに○を入力しようと思っているのですが、シート2の日付を検索はしているんですが入力がいきません Sheet1  ↓セルA1 ↓セルB1  5月26日   26           B1のセルはDAY(A1)にて出してます         完売  A氏     ○             Sheet2  ↓A列   ↓B列 5月  1日  ・  ・  ・  26日    ○           ←シート1の所に○が付いているとシート1セルB1と同じ  27日                  日付の隣のセルに○を入力  28日 VBA Sub test() Sheets("Sheet2").Select Range("A1").Select Do Until ActiveCell = "" ActiveCell.Offset(1, 0).Activate If ActiveCell.Value = Worksheets("Sheet1").Range("B2") Then ActiveCell.Offset(0, 1).Activate If ActiveCell.Value <> "○" Then ActiveCell.Valu = "○" ActiveCell.Offset(0, -1).Activate Else ActiveCell.Offset(0, -1).Activate End If Else End If Loop Sheets("Sheet2").Select Range("A1").Select End Sub どこが間違っているかわからない状態です。 分かりにくい説明ではあるんですが教えてください お願いします。

  • マクロの処理速度を上げたい

    例えば"A1"から"Z100"までランダムに数字が入っている場合に、 次の処置をしたいのです。  処理A:10以下の数値を0に置き換える。 "A1"から始まるのはほぼ決まっているのですが、 最後のセルが決まっていません。 いろいろなときに使えるように下記マクロを作りましたが、 データ量が多いのか、処理に時間がかかってしまいます。 (本番データは200×3000件くらいあり、処理も例より複雑です) 処理は行えているみたいなので、速度を上げるのにいい方法はないか 相談させてください。 プログラムの知識は基本情報処理試験のC言語を勉強していた くらいです。マクロは本を見ながら作っているので、調べきれて いない部分もあるかもしれませんが、よろしくお願いいたします。 参考にしている本は、C&R研究所のEXCEL VBAハンドブックです。 ====ここから==== sub テスト() '使用する変数  dim LastColNum as integer  dim i as integer  'A1をアクティブにします  range("A1").select  '最後の列の行番号を調べます  LastColNum=range("A1").end(xlToRight).column  'アクティブなセルが空白になるまで処理を続けます  Do Until activecell.value=""   '行数分処理を続けます   for i=0 to LastColNum-1    '10未満だったら処理をします    if activecell.offset(0,i).value<10 then     '10未満のセルに0を入力します。     activecell.offset(0.i).value=0    end if   next   '次の行をアクティブにします   activecell.offset(1,0).activate  Loop end

  • Do loopのマクロ

    以下のマクロの問題点を教えていただきたいのです。 A列を上から順番に調べて、値が10のときだけBに分岐して処理を行い(処理の内容は省略してあります)、またAに戻って、空白のセルが見つかったら処理をやめる、というマクロです。 ところが、これを実行すると空白のセルが見つかってもマクロが止まりません。何が問題でしょうか。 Sub A() Cells(1, 1).Select A: Do Until ActiveCell.Value = "" If ActiveCell.Value = 10 Then GoTo B End If ActiveCell.Offset(1, 0).Select Loop B: ActiveCell.Offset(1, 0).Select GoTo A End Sub

  • エクセルVBAで無限ループ

    教えてください。 以下の2つのエクセルマクロはまったく同じことをさせようとしているのですが、test02の方は.Offset(1).Activateが働かないのか、無限ループに陥ってしまいます。 単にActiveCell.という記述をWith~End Withでまとめただけなのになぜこうなるのでしょうか? Sub test01() ActiveSheet.Cells(1, 1).Activate Do While ActiveCell.Value <> "" If Not IsNumeric(ActiveCell.Value) Then ActiveCell.Offset(0, 1).Value = "文字" ElseIf ActiveCell.Value > 0 Then ActiveCell.Offset(0, 1).Value = "正数" ElseIf ActiveCell.Value < 0 Then ActiveCell.Offset(0, 1).Value = "負数" Else ActiveCell.Offset(0, 1).Value = "その他" End If ActiveCell.Offset(1).Activate i = i + 1 Application.StatusBar = i Loop End Sub Sub test02() ActiveSheet.Cells(1, 1).Activate With ActiveCell Do While .Value <> "" If Not IsNumeric(.Value) Then .Offset(0, 1).Value = "文字" ElseIf .Value > 0 Then .Offset(0, 1).Value = "正数" ElseIf ActiveCell.Value < 0 Then .Offset(0, 1).Value = "負数" Else .Offset(0, 1).Value = "その他" End If .Offset(1).Activate i = i + 1 Application.StatusBar = i Loop End With End Sub

  • :【Excel VBA】 Do Until ~ Loop 構文で途中の空白セルを飛ばしてデータのチェックをしたい

    こんにちは。 Do Until ~ Loop 構文で 空白セルまでループして重複する値をチェックしたいと考えています。 --------------------------------------------- Sub 重複チェック() Dim 検索語 As String Dim 該当数 As Long Dim 確認 As Integer Range("A4").Activate Do Until ActiveCell.Value = "" 検索語 = ActiveCell.Value 該当数 = WorksheetFunction.CountIf(Range("A:A"), 検索語) If 該当数 >= 2 Then ActiveCell.AutoFilter Field:=1, Criteria1:=検索語 確認 = MsgBox("次を検索しますか?", vbYesNo) If 確認 = vbNo Then Exit Sub End If ActiveCell.Offset(1, 0).Activate Loop Range("A4").AutoFilter MsgBox "名前の重複チェックが終了しました。" End Sub --------------------------------------------- ただセルA列には行の途中、空白も含まれているため、 途中で止まってしまいます。 今後A列にはデータが追加されていきます。 途中の空白セルを飛ばして、 データーの最後までチェックするにはどのようにすればよいでしょうか?

専門家に質問してみよう