Excel仕様書のセル内改行を解決-lunaplus.net

Excelのコピペの厄介

システム仕様書は、Excelで書かれていることが多いです。印刷するだけであれば特に問題にならないのですが、仕様書の中の文字列をデータとして利用したいときにセル内改行が非常にやっかいです。

日常的に感じることが多かったので、VBAのマクロでこれを解除するスクリプトを書いてみました。（少し冗長な気もするが、ひとまず・・・）

Public Sub getData() 
  Dim mList As Variant 
  Dim uList() As Variant 
  Dim tempData As Variant 
  Dim tempRows As Long 
  Dim tempRowNum As Long 
  Dim i As Long 
  Dim j As Long 
  Dim k As Long 
  
  'Microsoft Forms 2.0 Object Library 
  Dim mClipBoard As New DataObject 
  Dim mString As String 
  
  '選択範囲を指定 
  mList = Range(Selection(1), Selection(Selection.Count)) 
  
  'データ行数を取得する 
  ReDim uList(0, UBound(mList, 2) - 1) 
  For i = 1 To UBound(mList, 1) 
    tempRows = 1 
    For j = 1 To UBound(mList, 2) 
      tempData = Split(mList(i, j), vbLf) 
      If tempRows <= UBound(tempData) + 1 Then
        tempRows = UBound(tempData) + 1 
      End If
    Next
    ReDim uList(UBound(uList, 1) + tempRows, UBound(mList, 2) - 1) 
  Next
  ReDim uList(UBound(uList, 1) - 1, UBound(mList, 2) - 1) 

 '値を配列に設定する
  tempRowNum = 0 
  For i = 1 To UBound(mList, 1) 
    For j = 1 To UBound(mList, 2) 
      tempData = Split(mList(i, j), vbLf) 
      For k = 0 To UBound(tempData) 
        uList(tempRowNum + k, j - 1) = tempData(k)
      Next
      If tempRows <= UBound(tempData) + 1 Then
        tempRows = UBound(tempData) + 1 
      End If
    Next
    tempRowNum = tempRowNum + tempRows 
  Next

  'クリップボードに値を設定する 
  mString = "" 
  For i = 0 To UBound(uList, 1) 
    For j = 0 To UBound(uList, 2) 
      mString = mString & uList(i, j) 
      If j < UBound(uList, 2) Then
        mString = mString & vbTab 
      End If
    Next
    mString = mString & vbCrLf 
  Next
  mClipBoard.SetText mString 
  Call mClipBoard.PutInClipboard
End Sub

[amazon_link asins=‘4774173673,4990512405,479738607X,4774190160,4990512413,4797388706,4774127930’ template=‘ProductCarousel’ store=‘lunalab-22’ marketplace=‘JP’ link_id=‘1c3ed637-912f-11e7-9a47-091d6fd4c41a’]

Excel仕様書のセル内改行を解決

ToC

Excelのコピペの厄介

FEATURED TAGS