youcune.com

結合されたセルの一部を変更するマクロ

Excel

我々SIerはMicrosoft Excelに触れる機会が多いと思います。SIerはドヤ顔ですぐExcelを方眼紙にするので頭おかしいと思っている私ですが、Excelをさわっていると、週に一度は、

f:id:youcune:20160831120126p:plain

f:id:youcune:20160831120207p:plain

のコンボをくらうことでしょう。なぜか、結合されたセルに文字列の貼り付けができないのです(編集モードに入ればできるけど、そうすると今度は複数セルにまたがって貼り付けられない)。と、いうことで対策マクロを作りました。もちろんタブ区切りで列、改行区切りで行に貼り付けられます。具体的にはこう。

f:id:youcune:20160831120220p:plain

ここに貼り付けたいとすると、

f:id:youcune:20160831120235p:plain

元になるTSVをコピーして、この例の場合はB3の上でマクロ実行!

f:id:youcune:20160831120242p:plain

以下ソースコード。Ctrl+Shift+Vとかにショートカットキーを割り当てておくと便利です。

Sub paste_value()
    Dim cb As New DataObject
    Dim sel As Range
    Set sel = Selection
    
    If Application.CutCopyMode Then
        sel.PasteSpecial Paste:=xlPasteFormulasAndNumberFormats
    Else
        ' ペーストの起点を決定
        Dim st As Range         ' ペースト起点
        Set st = sel.Range("A1")
        
        ' クリップボードからデータ取得
        Dim c_rows As Variant
        cb.GetFromClipboard
        c_rows = Split(cb.GetText, vbCrLf)
        
        ' 処理中の行/列番号
        Dim i_row As Integer
        i_row = st.Row
        Dim i_col As Integer
        i_col = st.Column
        
        ' ペースト処理
        For i = LBound(c_rows) To UBound(c_rows)
            Dim c_cols As Variant
            c_cols = Split(c_rows(i), vbTab)
            For j = LBound(c_cols) To UBound(c_cols)
                Dim cell As Range
                Set cell = Cells(i_row, i_col)
                With cell
                    .Value = c_cols(j)
                    i_col = i_col + .MergeArea.Columns.Count
                End With
            Next j
            
            ' 改行
            i_col = st.Column
            i_row = i_row + Cells(i_row, i_col).MergeArea.Rows.Count
        Next i
    End If
End Sub

セルをコピーしているときは、値の貼り付け、文字列をコピーしているときは、結合されたセルの一部を変更貼り付けモードになります。これはきっと多くの場合、期待した動作になることでしょう。