000000 ランダム
 ホーム | 日記 | プロフィール 【フォローする】 【ログイン】

勉強ブログ

PR

X

プロフィール


09022535

カレンダー

バックナンバー

2021.04
2021.03
2021.02
2021.01
2020.12

カテゴリ

日記/記事の投稿

コメント新着

コメントに書き込みはありません。

キーワードサーチ

▼キーワード検索

2018.05.30
XML

tst

カテゴリ:マクロ
'呼び出し元
'内容=取り消し線のあるセルの値をクリアし、その行を黄色で塗る
'対象=Range(Cells(1, 1), Cells(1000, 100))
'空白行で取り消し線のあったセルの塗りつぶしは行わない
Function clr_value()
Dim tst As Range

For Each tst In ThisWorkbook.ActiveSheet.Range(Cells(1, 1), Cells(1000, 100))
Call del_strkthr_range(tst)
Next



For Each tst In ThisWorkbook.ActiveSheet.Range(Cells(1, 1), Cells(1000, 100))
tst.Value = del_strkthr_char(tst)
Next

MsgBox "End"
End Function




'呼び出し先
Function del_strkthr_range(cell As Range)
If cell.Font.Strikethrough = True And cell.Value <> "" Then
cell.Value = ""
If WorksheetFunction.CountA(Rows(cell.Row)) = 0 Then
Rows(cell.Row).Interior.ColorIndex = 6
Else
End If
Else
End If


End Function


'呼び出し先
Function del_strkthr_char(cell As Range)
Dim count As Integer
Dim i As Integer
Dim char As Characters
Dim result As String
count = Len(cell.Text)
For i = 1 To count
Set char = cell.Characters(i, 1)
If Not char.Font.Strikethrough Then
result = result + char.Text
End If
Next
del_strkthr_char = result
End Function















最終更新日  2018.05.30 15:05:30
コメント(0) | コメントを書く
[マクロ] カテゴリの最新記事



© Rakuten Group, Inc.