1
1

Delete article

Deleted articles cannot be recovered.

Draft of this article would be also deleted.

Are you sure you want to delete this article?

More than 1 year has passed since last update.

ベタ打ち数値は青、などを自動化

Last updated at Posted at 2022-04-24

マクロの入れ方など

Excelスターターキットのマクロ化(&クイックアクセスツールバー設定)
上記にて詳述しているので、ご参考ください。

2204242320追記

pivotテーブルの数値も青になってしまっていたため、黒となるように修正しました

2204251320追記

保護されているシートが含まれる場合エラーが出てしまう点を修正。
(保護されているシートについては処理をしない形で修正)

コード

Sub 色変える()
'
' 色変える Macro
'

' 画面更新をさせない(チカチカするため)
Application.ScreenUpdating = False
'
Dim ws As Worksheet
' 各シートを順番に見ていく
For Each ws In Worksheets
    ' シート保護されてるか確認
    If ws.ProtectContents = True Then
    '保護されてたら何もしない
    Else
    '保護されていなかったら処理を走らせる
        ws.Activate
        ws.UsedRange.Select
    ' ベタ打ちの数値→青、他シート参照の数式→緑、他→黒に変更
        For Each a In Selection
            If a.HasFormula Then
                If InStr(a.Formula, "!") > 0 Then
                    a.Font.Color = RGB(112, 173, 71)
                Else
                   a.Font.Color = RGB(0, 0, 0)
                End If
            Else
                If IsNumeric(a.Value) = True Then
                    a.Font.Color = vbBlue
                Else
                    a.Font.Color = vbBlack
                End If
            End If
        Next a
    
    ' pivot処理
    On Error GoTo ERR_HNDL
    For Each piv In ActiveSheet.PivotTables
    piv.TableRange1.Select
    Selection.Font.Color = vbBlack
    Next piv
ERR_HNDL:
    ' pivot処理ここまで
    
    
    Range("A1").Select
    ' 表示位置を左上端に移動
    ActiveWindow.ScrollColumn = 1
    ActiveWindow.ScrollRow = 1
    End If
Next ws
' 1枚目のシートに移動
Sheets(1).Select
'画面更新を再開させておく
Application.ScreenUpdating = True
' メッセージを表示
MsgBox "処理が完了しました"


'
End Sub


実行前エクセル

E3のみ数式
image.png
D2は他シート参照
image.png

実行後エクセル

ベタ打ち→青、他は黒
image.png
他シート参照なので緑に
image.png

注意点

全シートでアクティブセルすべてに対して処理を走らせているため、シート数やアクティブセルが多い場合、実行時間が長くなる場合がございます。
ご利用は自己責任にてお願い致します。(こうした方が早くなる等ありましたらご指摘いただけますと幸いです。

おまけ-pivot tableのリスト化など

選択しているピボットテーブルに下記変更を行うマクロ
①レポートのレイアウト→表形式&アイテムラベルを繰り返す
②小計&総計を集計しない

Sub pivotリスト形式()
'
' pivotリスト形式 Macro
'
On Error GoTo ERR_HNDL
With ActiveSheet.PivotTables(ActiveCell.PivotTable.Name)
    .RowAxisLayout xlTabularRow
    .RepeatAllLabels xlRepeatLabels
    .ColumnGrand = False
    .RowGrand = False
  End With
  
Dim pv_fld As PivotField
  For Each pv_fld In ActiveSheet.PivotTables(ActiveCell.PivotTable.Name).PivotFields
    pv_fld.Subtotals(1) = True
    pv_fld.Subtotals(1) = False
  Next pv_fld
'

ERR_HNDL:


End Sub

1
1
0

Register as a new user and use Qiita more conveniently

  1. You get articles that match your needs
  2. You can efficiently read back useful information
  3. You can use dark theme
What you can do with signing up
1
1

Delete article

Deleted articles cannot be recovered.

Draft of this article would be also deleted.

Are you sure you want to delete this article?