takayukisの日記 このページをアンテナに追加 RSSフィード

2018.05.16(水)

[]固定長テキストをクリップボードからペースト

各列の桁数を1行(横長)に記載して、その範囲を選択している状態でマクロを実行します。

指定した桁数をオーバーする部分はすべて右端のセル(4列選択した場合は5列目)に入ります。

テキストファイルウィザードで固定長テキストを指定すると、初期状態で自動的に区切りを入れられて解除が非常に苦痛を伴うという余計な機能があったため作成。

Sub 固定長テキストをクリップボードからペースト()

    ' 選択範囲から定義情報を取得する
    Dim 選択範囲 As Range
    Set 選択範囲 = Selection

    If 選択範囲.Rows.Count > 1 Then
        Exit Sub
    End If

    Dim 横幅() As Integer
    Dim セル
    Dim i As Integer
    i = 0
    ReDim 横幅(選択範囲.Columns.Count - 1)
    For Each セル In 選択範囲
       横幅(i) = セル.Value
       i = i + 1
    Next

    ' クリップボードからテキストを読み込む
    Dim cb As New DataObject
    cb.GetFromClipboard

    Dim text As String
    If cb.GetFormat(1) Then
        text = cb.GetText
    Else
        Exit Sub
    End If

    Dim lines() As String
    lines = Split(text, vbCrLf)

    Dim 挿入行数 As Long
    挿入行数 = UBound(lines) + 1
    Range((選択範囲.Row + 1) & ":" & (選択範囲.Row + 挿入行数)).Insert


    Dim str As String
    Dim 行番号 As Long
    For i = 0 To UBound(lines)
        行番号 = 選択範囲.Row + 1 + i
        str = lines(i)
        Dim 長さ
        Dim 開始位置 As Integer
        開始位置 = 0
        Dim 列番号 As Long
        列番号 = 選択範囲.Column
        Dim 文字列 As String
        For Each 長さ In 横幅
            文字列 = Mid(str, 開始位置 + 1, 長さ)
            Cells(行番号, 列番号).Value = 文字列
            開始位置 = 開始位置 + 長さ
            列番号 = 列番号 + 1
        Next
        文字列 = Mid(str, 開始位置 + 1)
        Cells(行番号, 列番号).Value = 文字列
    Next

End Sub

はてなユーザーのみコメントできます。はてなへログインもしくは新規登録をおこなってください。

トラックバック - http://d.hatena.ne.jp/takayukis/20180516/1526484156