選択セル内の文字列を集約して、コメントとして挿入する。

仕事で、このような価格表を扱った。
f:id:Infoment:20190515214429p:plain

これだけなら何の問題もないのだが、残念なことに、このような形で注釈が記入されていた。
f:id:Infoment:20190515214953p:plain

記載者は、良かれと思って注意事項を書いてくれている。しかし、このような形で注意事項を書かれてしまうと、

  1. 表をソートできない。
  2. データ的に、「みかん」の注釈なのか「ばなな」の注釈なのかわかりにくい。

など様々な不都合があって、とても扱いにくい表になっている。

そこでまず、選択した範囲に於いて、2つ目以降のセル内にある文字列を改行で合成し、1つ目に選択したセルのコメントとして挿入するマクロを作成してみた。

Function GetStringForComment() As String
    Dim col As Collection
    Set col = New Collection

    Dim r As Range
        For Each r In Selection
            col.Add r
        Next

    Dim i As Long
    Dim arr As Variant
    ReDim arr(1 To col.Count - 1)
        For i = 2 To col.Count
            arr(i - 1) = col.Item(i)
        Next

        GetStringForComment = Join(arr, vbNewLine)
End Function
Sub ToComment()
    Dim TargetRange As Range
        If Selection.Count = 1 Then
            Exit Sub
        Else
            Set TargetRange = Selection.Item(1)
        End If

        With TargetRange
            .ClearComments
            .AddComment
            With .Comment
                .Visible = False
                .Text Text:=GetStringForComment
                .Shape.TextFrame.Characters.Font.Name = "メイリオ"
                .Shape.TextFrame.Characters.Font.Size = 10
                .Shape.TextFrame.AutoSize = True
            End With
        End With
        TargetRange.Select
End Sub

先程の表で試してみると、このような結果になった。
f:id:Infoment:20190515215752g:plain

コメントが上に行に書いてあったり、下に書いてあったりで法則性が無いため、ここからは一つずつの手作業になるわけだが、今回作成したマクロである程度手間を減らすことが出来そうだ(でも3000レコードほどあるので、大変なのは間違いない)。

実はこの価格表、他にも色々と突っ込みどころを抱えておりまして。しばらくは、改善三昧(=ブログのネタ発掘しまくり)の日々を送れそうです。

参考まで。