VBA 100本ノックNo11~14

#VBA100本ノック 11本目
11…同じ数字が並んでいる、これは結合したのか、、、

画像のようにシートにはところどころにセル結合があります。
これは放置しておく訳にはいきません。
セル結合されているセルには、メモ（旧コメント）で警告文を出しましょう。
※シートは任意、警告文はご随意に pic.twitter.com/Vi5HoXJtDy

— エクセルの神髄 (@yamaoka_ss) 2020年10月29日

Sub ノック11本目()
With Worksheets("セル結合")
Dim r As Long: r = .Cells(Rows.Count, 1).End(xlUp).Row
Dim c As Long: c = .Cells(1, Columns.Count).End(xlToLeft).Column

Dim i As Long, j As Long
For i = 1 To r
    For j = 1 To c
        If .Cells(i, j).MergeCells Then .Cells(i, j).AddComment.Text "セル結合…しましたね…(´・ω｜"
    Next
Next
End With
End Sub

#VBA100本ノック 12本目
A1から始まる表範囲のC列に金額が入っています。
しかし、ところどころに結合されたセルがあります。
セル結合を解除し、入っている金額を整数で均等に割り振ってください。（2枚目画像）
端数処理方法は任意とします。
※結合セルには正の整数しか入っていません。 pic.twitter.com/AiRgfucnRx

— エクセルの神髄 (@yamaoka_ss) 2020年10月30日

Sub ノック12本目()
With Worksheets("セル結合")
Dim r As Long: r = .Cells(Rows.Count, 1).End(xlUp).Row
Dim c As Long: c = .Cells(1, Columns.Count).End(xlToLeft).Column

Dim i As Long, j As Long, k As Long, md As Integer
Dim trg As Range
Dim amount As Long '金額
For j = 1 To c
    For i = 1 To r
        If .Cells(i, j).MergeCells Then                                                          'セルの結合判定
            Set trg = .Cells(i, j).MergeArea
            trg.UnMerge
            md = .Cells(i, j).Value Mod trg.Rows.Count                                              '余りの計算
            If md = 0 Then                                                                          '割り切れる場合
                amount = .Cells(i, j).Value / trg.Rows.Count
                For k = 1 To trg.Rows.Count                                                             '結合範囲のループ処理
                    .Cells(i + k - 1, j).Value = amount
                Next
            Else                                                                                    '端数が出る場合
                amount = WorksheetFunction.RoundDown(.Cells(i, j).Value / trg.Rows.Count, 0)
                For k = 1 To trg.Rows.Count                                                             '結合範囲のループ処理
                    Select Case k
                    Case Is <= md                                                                       '余りの配賦
                        .Cells(i + k - 1, j).Value = amount + 1
                    Case Else
                        .Cells(i + k - 1, j).Value = amount
                    End Select
                Next
            End If
        End If
    Next
Next
End With

End Sub

#VBA100本ノック 13本目
選択セル（Selection:複数範囲あり）の文字列に「注意」という文字があった場合は、その「注意」の文字だけを"赤の太字"に設定してください。
セル以外（図形等）が選択されている場合は何もせずに正常終了するようにしてください。 pic.twitter.com/UqvvJu8GFm

— エクセルの神髄 (@yamaoka_ss) 2020年10月31日

Sub ノック13本目()
Dim arr As Variant, Target As Range
If TypeName(Selection) = "Range" Then
    Set Target = Selection
    For Each arr In Target
        Dim i As Long
        Dim start As Integer: start = 1
        
        Do
        If Not (InStr(start, arr.Value, "注意") = 0) Then
            arr.Characters(InStr(start, arr.Value, "注意"), 2).Font.Color = RGB(255, 0, 0)
            start = InStr(start, arr.Value, "注意") + 2
        End If
        Loop Until InStr(start, arr.Value, "注意") = 0
    Next
End If
End Sub

#VBA100本ノック 14本目
客先へ送付するブックを作成します。
シート名に「社外秘」の文字が含まれるシートを削除してください。
他のシートは計算式を消して値だけにしてください。
※シート間参照の数式あり。
※条件付き書式・入力規則は未使用。
※対象はアクティブブックで構いません。 pic.twitter.com/qt5skqdfYo

— エクセルの神髄 (@yamaoka_ss) 2020年11月2日

Sub ノック14本目()
Dim wsName As String
Dim ws As Worksheet
Dim cnt As Long
For Each ws In Worksheets
    wsName = ws.Name
    If Not (InStr(wsName, "社外秘") = 0) Then
        Application.DisplayAlerts = False
        Worksheets(wsName).Delete
        Application.DisplayAlerts = True
        cnt = cnt + 1
    End If
Next
MsgBox cnt & "枚のコードを削除しました"
End Sub

振り返りと反省

• セル結合に関わるメソッド（MergeCells、MergeAreaなど）をうまく使いこなせていない
• 結合セルのカウントと端数処理が回りくどい気がする
• Charactersプロパティ使ったのが久々。Value（値）とCharacters（文字列オブジェクト）の違いをしっかり理解する
• InStrは便利なので使いこなせるように意識して使ってみる