ここから本文です

ExcelのVBAについて 全シート同じ処理をしようとしても1回目は半分しか処理されず...

アバター

ID非公開さん

2017/8/2720:42:06

ExcelのVBAについて
全シート同じ処理をしようとしても1回目は半分しか処理されず、
2回目を実行すると全て上手く処理されます。

こんにちは。VBAについて質問です。

やりたいこととし

ては、
・シート内の空白セルを選択
・空白セルの書式が「赤字」のセルがあれば全て「黒字(自動)」に変更する
・空白セルの書式で「取り消し線」があれば全て消す(取り消し線を解除する)
・処理が終わったら最初のシートのA1セルを選択する

以上の簡単なマクロです。
プログラムとしては、
①赤字を黒にするもの
②取り消し線を消すもの
③上記①、②を合わせてボタン一つで処理可能に

なのですが、試しにシートを3つ作成し、
各シートの空欄セルにそれぞれ赤字、取り消し線、その両方
を書式として設定し、テストしているのですが、
1回目の処理を実行し、各シートを確認すると赤字が残っていたり取り消し線が残っていたり
または消えているところもあったり、、、

ただ2回目を実行すると残りが全て消えます。

コードは以下になります。

なぜ一回で処理されないのか、説明も頂けると幸いです。

ーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーー
Option Explicit

Sub 赤字削除()

Dim ws As Worksheet
For Each ws In Worksheets
ws.Activate
Dim r As Range, rng As Range
Set rng = Selection.SpecialCells(xlCellTypeBlanks)
For Each r In rng
If Not r.MergeCells Then
r.Font.ColorIndex = xlAutomatic
End If
Next r
Next ws

Sheets(1).Select
Range("a1").Select

End Sub

ーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーー
Sub 取り消し線削除()

Dim ws As Worksheet
For Each ws In Worksheets
ws.Activate
Dim r As Range, rng As Range
Set rng = Selection.SpecialCells(xlCellTypeBlanks)
For Each r In rng
If Not r.MergeCells Then
r.Font.Strikethrough = False
End If
Next r
Next ws

Sheets(1).Select
Range("a1").Select

End Sub

ーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーー
Sub 削除()

Call 赤字削除
Call 取り消し線削除
End Sub

この質問は、活躍中のチエリアン・専門家に回答をリクエストしました。

閲覧数:
49
回答数:
1
お礼:
100枚

違反報告

ベストアンサーに選ばれた回答

sk_********さん

2017/8/2722:09:19

これで希望の動作になると思います。ID非公開さんのコードを少し改変しています。

Sub 赤字削除()
Dim ws As Worksheet, r As Range, rng As Range
For Each ws In Worksheets
Set rng = ws.UsedRange.SpecialCells(xlCellTypeBlanks)
For Each r In rng
If Not r.MergeCells Then
r.Font.ColorIndex = xlAutomatic
End If
Next
Next
End Sub

Sub 取り消し線削除()
Dim ws As Worksheet, r As Range, rng As Range
For Each ws In Worksheets
Set rng = ws.UsedRange.SpecialCells(xlCellTypeBlanks)
For Each r In rng
If Not r.MergeCells Then
r.Font.Strikethrough = False
End If
Next
Next
End Sub

Sub 削除()
Call 赤字削除
Call 取り消し線削除
Sheets(1).Activate
Range("A1").Select
End Sub

>なぜ一回で処理されないのか、説明も頂けると幸いです。
おそらく、
Selection.SpecialCells(xlCellTypeBlanks)
の部分だと思います。
これは選択されているセル範囲の中で、空白のセルという意味になります。
つまり、選択されていない空白セルは対象外になります。


別件ですが、
この処理は、シートをアクティブにしなくても実行可能です。
また、赤字削除と取り消し線削除は、ほぼ同じ処理なので、あわせたらよいのではないでしょうか。事情があるのかもしれませんが。

それらを踏まえ、一つの例です。

Sub Sample()
Dim ws As Worksheet, r As Range, rng As Range
For Each ws In Worksheets
Set rng = ws.UsedRange.SpecialCells(xlCellTypeBlanks)
For Each r In rng
If Not r.MergeCells Then
r.Font.ColorIndex = xlAutomatic
r.Font.Strikethrough = False
End If
Next
Next
End Sub

  • アバター

    質問者

    ID非公開さん

    2017/8/2722:48:48

    希望通りのマクロになりました!!!
    ご丁寧にご説明まで頂きありがとうございました!

返信を取り消しますが
よろしいですか?

  • 取り消す
  • キャンセル

みんなで作る知恵袋 悩みや疑問、なんでも気軽にきいちゃおう!

Q&Aをキーワードで検索:

Yahoo! JAPANは、回答に記載された内容の信ぴょう性、正確性を保証しておりません。
お客様自身の責任と判断で、ご利用ください。
本文はここまでです このページの先頭へ

「追加する」ボタンを押してください。

閉じる

※知恵コレクションに追加された質問は選択されたID/ニックネームのMy知恵袋で確認できます。

不適切な投稿でないことを報告しました。

閉じる