Option Explicit
Sub font()
Dim rng As Range
Dim ws As Worksheet, ws0 As Worksheet
Set ws0 = ActiveSheet
Set ws = Worksheets.Add
ws0.Activate
For Each rng In Range("A1:Z100")
If Not Cells(rng.Row, rng.Column) = "" Then
ws.Cells(ws.Cells(Rows.Count, 1).End(xlUp).Row + 1, 1) = rng.Address
ws.Cells(ws.Cells(Rows.Count, 2).End(xlUp).Row + 1, 2) = rng.font.Name
End If
Next
End Sub
実際の動きを見ていきましょう。
まずは、Excelで文字のインプットされたファイルを用意してください。
STEP
文字がインプットされたExcelを用意しましょう。
画像はサンプルです。実はこのなかにフォント違いが4つ隠れています。
まずは、平たく見てください。わかりますか？
STEP
マクロのコードをコピペして実行して見ましょう。
画像の通り、マクロのコードをコピペして実行してみましょう。
「Alt」+「F11」でマクロのコードを書くウィンドウを開きます。
コピペして「F5」で実行しましょう。
STEP
実行結果を確認しましょう。
まずは新しいシートが作られます。
そのシートを確認すると、インプットされた文字のアドレスとフォント名が表示されています。
オートフィルタをかけてフォント名を絞りましょう。
画像の通り、フォント名が違うアドレスが分かります。
STEP
実行時間は数秒です。
瞬く間に処理が終わります。
フォントが違うセルを黄色にしました。
Excelマクロのコードの解説とアレンジ
１２行目でフォントの一覧を作るセルの範囲を指示しています。
今回のセル範囲は”Ａ１：Ｚ１００”です。
まだまだ見たいという人は”A1:Z100”を編集しましょう。
とはいえ、広すぎると処理の時間がかかりますので注意しましょう。
Option Explicit
Sub font()
Dim rng As Range
Dim ws As Worksheet, ws0 As Worksheet
Set ws0 = ActiveSheet
Set ws = Worksheets.Add
ws0.Activate
For Each rng In Range("A1:Z100")
If Not Cells(rng.Row, rng.Column) = "" Then
ws.Cells(ws.Cells(Rows.Count, 1).End(xlUp).Row + 1, 1) = rng.Address
ws.Cells(ws.Cells(Rows.Count, 2).End(xlUp).Row + 1, 2) = rng.font.Name
End If
Next
End Sub
ポチップ
にほんブログ村
コメント