VBAの勉強を始めてみた

色々試しています。

電気の雑学 ブラックアウト・ブラックスタートについて分かりやすく説明する試み(雑記-15)

今回は VBA とはまったく関係ありません。書くことも無くなってきた たまには違うことも書いてみましょう。

 

2018年9月6日に起こった、北海道胆振地方の地震および全域停電はまだ記憶に新しいところです。被災された方、停電で日常生活が困難になった方はとても大変だったことだろうと思います。
その間、テレビのニュースなどでは ブラックアウト という聞き慣れない言葉が頻繁に出てきました。今回はブラックアウトについて、さらにもっと聞き慣れないブラックスタートについても簡単に説明をしてみたいと思います。

 

ブラックアウトとは?

例えば、スポーツジムなどにあるエアロバイクをA君、B君、C君で漕いでいるとします。特別ルールとして、エアロバイクは常に一定の回転数で漕がなければなりません。このときエアロバイクが「負荷」、漕いでいる人が「発電機」、回転数が「商用周波数」に当たります。

9月6日の事象では、A君が苫東厚真火力発電所です。

漕いでいる途中で一番パワーのあるA君が膝を痛めて地震で被災して)離脱してしまいました。漕ぐ力が2/3以下となってしまって回転数を維持することがしんどくなり、B君が離脱・・・・・・ほどなくしてC君も離脱。これでエアロバイクは完全に停止・・・・・・。これがブラックアウトです。

 

ブラックスタートとは?

さて、完全に停止したエアロバイクを再び回転させるにはどうすればいいでしょうか?まず、一人で<軽めの負荷で>漕ぎ、回転数を維持しつつ、徐々に負荷を増やしていきます。負荷に合わせて漕ぐ人数も二人・三人と増やしていきます。で、完全復旧!

ってな風に、簡単にはいきません。

人間は電気がなくても活動ができますが、発電機は電気なしで発電を開始することができません。皮肉な話ですが。
全電源が喪失されたなかで発電を開始するには・・・・・・はて?どうしましょう(@_@;)

 

実はこういう時のために外部電源なしでも発電を開始することができる 特殊な水力発電所<ブラックスタート機能を有する発電機> がいくつか用意されています。エンジン発電機などを組み込んであり、それで発電した電気を用いて水力発電機を起動する仕組みです。(その、エンジン発電機自体はバッテリーなどを火種にして起動しています・・・・・・)

発電した電気を途中で消費されないようになるべく負荷を切り離した状態で、火力発電所などに送り届けます。(ポジトロンスナイパーライフルに電力を集中させるヤ○マ作戦のようだ。と、いうのは不謹慎なのでお控え下さい( ̄ω ̄;))

f:id:kouten0430:20181027163146j:plain

 

次に火力発電所などを起動します。

f:id:kouten0430:20181027163238j:plain

 

負荷を接続し停電を解消します。

f:id:kouten0430:20181027163305j:plain

 

これはかなり簡略化した図ですが、実際の順番やタイミングはもっと複雑怪奇です。

f:id:kouten0430:20181027163350j:plain

 

9/6 ~ 8に行われたブラックスタートは一回目が失敗に終わり、二回目で成功したそうです。

 

疑問を自分で回答してみる!

自分で感じた疑問を自分自身で回答してみます!専門家のツッコミは受け付けません。

疑問1

Q.太陽光や風力でブラックアウトは阻止できないの?また、ブラックスタートはできないの?

  • A.今の技術だと太陽光や風力は・・・・・例えるなら エアロバイクを力のある別の誰か(例えば火力や原子力)が先に漕いでいること が前提の補佐的発電しか行うことができません。漕ぐ力も弱め、かつ気まぐれです。なので、電源の主軸となることができません。

 

疑問2

Q.本州側から電気の融通はできなかったの?

  • A.本州側から海底ケーブルを通じて融通できる上限は60万kWです。苫東厚真火力発電所の停止で喪失した電源は165万kWであることを考えると、足りていません。また、片方がブラックアウトしている状態では 交直変換 ができないという欠点もあるそうです。

    f:id:kouten0430:20181027164008j:plain

 

疑問3

Q.原発は起動できないの?

  • A.国の許可が下りるまでは起動できません。

 

ブラックアウト・ブラックスタート・それに関連した疑問等についてざっくりと説明してみましたが、なんとなく分かっていただけたでしょうか?普段あたりまえのように使っている電気ですが、今回のように全域で喪失する場合があることも分かりました。これを機に、電気のみならず ライフラインと呼ばれるもの(電気・ガス・水道・電話・インターネット・交通 等)が普段不自由なく使えることのありがたみを考えてみるのもいいかもしれませんね。

Word 左からの文字数指定で置換する

前回は段落の両端に対しての処理でしたが、今回は段落の内側にアプローチしてみたいと思います。
ということで、左からの文字数指定で各段落の内側を置換するマクロを作ってみました。

 

前回と同じように任意の範囲を選択します。
仮に左から5文字目を置換開始位置にし、そこから3文字分を ヽ(‘ ∇‘ )ノ に置換してみます。

f:id:kouten0430:20181021110734j:plain

 

f:id:kouten0430:20181020125923j:plain

 

範囲選択してからマクロ実行。InputBox の指示に従い、置換開始位置、置換開始位置からの文字数、指定文字を入力するだけで使えます。

コードはこちら。

Sub 左からの文字数指定で置換する()
    '選択範囲内にある各段落に対して処理します
    'ReplaceEndが0指定のときは、置換開始位置の左側に挿入されます
    Dim ReplaceStart As Integer
    Dim ReplaceEnd As Integer
    Dim 指定文字 As String
    Dim SelectionStart As Integer
    Dim SelectionEnd As Integer
    Dim 段落 As Paragraph
    
    ReplaceStart = InputBox("左から何文字目を置換開始位置にしますか?")
        If ReplaceStart < 1 Then
            ReplaceStart = 1
        End If
    ReplaceEnd = InputBox("開始位置から何文字分を置換しますか?")
        If ReplaceEnd < 0 Then
            ReplaceEnd = 0
        End If
    
    指定文字 = InputBox("置換後の文字を入力して下さい。")
        If 指定文字 = "" Then
            Exit Sub
        End If

    'Textプロパティで選択が解除されるので、選択範囲を記憶させる
    SelectionStart = Selection.Start
    SelectionEnd = Selection.End
    
    For Each 段落 In ActiveDocument.Range(SelectionStart, SelectionEnd).Paragraphs
        If 段落.Range.Start + ReplaceStart - 1 < 段落.Range.End - 1 Then    '開始位置が段落の文字数を超過している場合は処理しない
            If 段落.Range.Start + ReplaceStart + ReplaceEnd - 1 <= 段落.Range.End - 1 Then
                ActiveDocument.Range(段落.Range.Start + ReplaceStart - 1, _
                段落.Range.Start + ReplaceStart + ReplaceEnd - 1).Text = 指定文字
            Else    '開始位置からの文字数が段落の範囲を超える場合、強制的に範囲内で収める
                ActiveDocument.Range(段落.Range.Start + ReplaceStart - 1, _
                段落.Range.End - 1).Text = 指定文字
            End If
        End If
    Next
    
End Sub

 

※コードの大まかな流れ

  • まず左から何文字目を開始位置にするか、開始位置から何文字分を置換するか、置換後の文字を何にするか InputBox で指定します。
  • 現在の選択範囲の開始位置と終了位置を変数に入れておきます(処理中に選択が解除されてしまうため)。
  • For Each ~Next で、選択範囲内の段落すべてにループ処理を行います。
  • ループ内の処理:置換開始位置から指定文字分を Text プロパティで置換します。(条件分岐では、各段落の末端位置よりも置換開始位置が超過していた場合は処理をパスし、指定文字数が超過していた場合はマイナス補正〔末端位置まで〕をかけています。)

 

※コードの使用方法

  • SubからEnd Subまでをコピーし、標準モジュール等に貼り付けて使用して下さい。なお、マクロで実行した処理は「元に戻す」ことができません。実行前に一旦保存し、やり直しのできる状態にしておいて下さい。Wordで標準モジュールにコードを貼り付けてマクロを使用する方法はこちら

Word 選択範囲の段落の先頭または末尾に指定文字を挿入する

文書の各段落の先頭や末尾に文字をまとめて追加したい場面ってありませんか?
「俺(私)にそんな場面はないっ!」って方には、ここから下の記事は無用の長物です。他の場所に GoTo して下さい。

ということで、今回は選択範囲内にある各段落(の先頭または末尾)にマクロを使って指定文字を挿入させてみようと思います。

実験に協力していただくのは次の文書です。

f:id:kouten0430:20181017131736j:plain

注:魂の叫びではありません。

 

目次

 

各段落の先頭に指定文字を挿入する

任意の範囲を選択した状態でマクロを実行。マクロ実行後に表示される InputBox で入力した文字が各段落の先頭に挿入されるようにします。

f:id:kouten0430:20181017131856j:plain

 

コードはこちらです。

Sub 選択中の段落の先頭に指定文字を挿入する()
    Dim 指定文字 As String
    Dim 段落 As Paragraph
    
    指定文字 = InputBox("先頭に挿入する文字を入力して下さい。")
        If 指定文字 = "" Then
            Exit Sub
        End If
    
    For Each 段落 In Selection.Paragraphs
        段落.Range.InsertBefore 指定文字
    Next
    
End Sub

 
選択範囲内の段落すべてに For Each ~Next でループ処理を行うようにします。
ループ内では、一つの段落の範囲に対して InsertBefore で先頭に指定文字を挿入させています。これは簡単ですね。

 

 

各段落の末尾に指定文字を挿入する

考え方は先ほどと同じですが、今度は指定文字が各段落の末尾に挿入されるようにします。

f:id:kouten0430:20181017132919j:plain

 

コードはこちらです。

Sub 選択中の段落の末尾に指定文字を挿入する()
    Dim 指定文字 As String
    Dim 段落 As Paragraph
    
    指定文字 = InputBox("末尾に挿入する文字を入力して下さい。")
        If 指定文字 = "" Then
            Exit Sub
        End If
    
    For Each 段落 In Selection.Paragraphs
       ActiveDocument.Range(0, 段落.Range.End - 1).InsertAfter 指定文字 '改行の手前に挿入するのがポイント
    Next
    
End Sub

 

先ほどのコードを、 InsertBefore から InsertAfter に変えるだけでは上手くいかないので若干工夫が必要です。
そのまま InsertAfter にすると改行の後ろ(つまり次の段落の先頭)に文字が挿入されてしまいます。なので Range.End から-1文字の位置(つまり改行の前)に挿入させましょう。この時、段落の Range は引数指定できないので、 ActiveDocument.Range を使用します。

 

 

各段落の先頭にクリップボードの各文字を挿入する

ここからはおまけです。
各段落の先頭に InputBox の指定文字ではなく、クリップボードの各行の文字を挿入させます。

f:id:kouten0430:20181017133409j:plain

 

コードはこちらです。

Sub 選択中の段落の先頭にクリップボードのデータを貼り付け()
    Dim myLib As Object
    Set myLib = CreateObject("new:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}")  '参照設定なしでDataObjectのインスタンスを生成する
    Dim 全文字列 As String
    Dim 分割文字列 As Variant
    Dim i As Integer
    Dim 段落 As Paragraph
    
    myLib.GetFromClipboard
    
    On Error Resume Next
    
    全文字列 = myLib.GetText
    
    On Error GoTo 0
    
    If 全文字列 <> "" Then
        分割文字列 = Split(全文字列, vbCrLf)  '全文字列を改行で分割し配列に格納する
        i = 0
    
        For Each 段落 In Selection.Paragraphs
            If i <= UBound(分割文字列) Then
                段落.Range.InsertBefore 分割文字列(i)
                i = i + 1
            Else
                Exit For
            End If
        Next
        
    Else
        MsgBox "クリップボードにデータがありません!"

    End If
    
End Sub

 

 

各段落の末尾にクリップボードの各文字を挿入する

各段落の末尾に InputBox の指定文字ではなく、クリップボードの各行の文字を挿入させます。

f:id:kouten0430:20181017133534j:plain

 

コードはこちらです。

Sub 選択中の段落の末尾にクリップボードのデータを貼り付け()
    Dim myLib As Object
    Set myLib = CreateObject("new:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}")  '参照設定なしでDataObjectのインスタンスを生成する
    Dim 全文字列 As String
    Dim 分割文字列 As Variant
    Dim i As Integer
    Dim 段落 As Paragraph
    
    myLib.GetFromClipboard
    
    On Error Resume Next
    
    全文字列 = myLib.GetText
    
    On Error GoTo 0
    
    If 全文字列 <> "" Then
        分割文字列 = Split(全文字列, vbCrLf)  '全文字列を改行で分割し配列に格納する
        i = 0
    
        For Each 段落 In Selection.Paragraphs
            If i <= UBound(分割文字列) Then
                ActiveDocument.Range(0, 段落.Range.End - 1).InsertAfter 分割文字列(i) '改行の手前に挿入するのがポイント
                i = i + 1
            Else
                Exit For
            End If
        Next
        
    Else
        MsgBox "クリップボードにデータがありません!"

    End If
    
End Sub

 

 

※コードの使用方法

  • SubからEnd Subまでをコピーし、標準モジュール等に貼り付けて使用して下さい。なお、マクロで実行した処理は「元に戻す」ことができません。実行前に一旦保存し、やり直しのできる状態にしておいて下さい。Wordで標準モジュールにコードを貼り付けてマクロを使用する方法はこちら

Word 開いている全文書の同じ行にクリップボードのデータを貼り付ける

今回は Word で開いているすべての文書の同じ行(厳密にいうと段落※)にクリップボードのデータを貼り付けさせてみたいと思います。

 

イメージとしてはこんな感じ。

f:id:kouten0430:20181014143415j:plain

 

マクロ実行時にアクティブな文書(最前面にある文書)のカーソル位置を読み取り、すべての文書の同じ行にデータを貼り付けします。

貼り付けされる順番は、アクティブな文書から・・・・・・ではなく、どの文書がアクティブであろうとも文書を開いた順番と逆(最後に開いた文書 → 最初に開いた文書)になるので注意して下さい。

 

コードはこちら。

Sub 現在開いている全文書の同じ行にクリップボードのデータを貼り付ける()
    '現在アクティブになっている文書のカーソル位置と同じ行(厳密には段落)にデータが貼り付けされます
    'データが貼り付けされる順番は文書を開いた順番と逆(最後に開いた文書 → 最初に開いた文書)になります
    Dim myLib As Object
    Set myLib = CreateObject("new:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}")  '参照設定なしでDataObjectのインスタンスを生成する
    Dim 全文字列 As String
    Dim 分割文字列 As Variant
    Dim i As Integer
    Dim 段落番号 As Integer
    Dim 文書 As Document
    
    myLib.GetFromClipboard
    
    On Error Resume Next
    
    全文字列 = myLib.GetText
    
    On Error GoTo 0
    
    If 全文字列 <> "" Then
        分割文字列 = Split(全文字列, vbCrLf)  '全文字列を改行で分割し配列に格納する
        i = 0
    
        段落番号 = ActiveDocument.Range(0, Selection.End + 1).Paragraphs.Count  'カーソル位置の段落番号を取得する
    
        For Each 文書 In Documents  '処理の順番は文書を開いた順番と逆になることに注意!
            If i <= UBound(分割文字列) Then
                文書.Paragraphs(段落番号).Range.InsertBefore 分割文字列(i)
                i = i + 1
            Else
                Exit For
            End If

        Next
        
    Else
        MsgBox "クリップボードにデータがありません!"

    End If
    
End Sub

 

※コードの大まかな流れ

  • まず、クリップボードの全文字列を変数に格納します。
  • 次に、Split関数を使って全文字列を改行(CrLf)で分割し配列に格納します。
  • アクティブな文書のカーソル位置の段落番号(つまり、カーソルがあるのは先頭から数えて何個目の段落か)を Paragraphs.Count でカウントして変数に格納します。※段落の先頭にカーソルがある場合、一つ前の段落までしかカウントされないため、先頭からカーソル位置+1文字の範囲内にある段落をカウントさせています。
  • For Each ~Next で、現在開いているすべての文書に対してループ処理を行います。
  • ループ内の処理:文書の該当の段落に配列の文字列を挿入します(次のループで、配列は次の要素に進みます)。ループの途中で配列の要素が尽きたら、ループを抜けて終了します。

 

※段落とは?

  • 改行の次の文字から次の改行までを指します。次の改行までが長くなると右端で折り返されて複数行に渡る場合もあります。

 

※コードの使用方法

  • SubからEnd Subまでをコピーし、標準モジュール等に貼り付けて使用して下さい。なお、マクロで実行した処理は「元に戻す」ことができません。実行前に一旦保存し、やり直しのできる状態にしておいて下さい。Wordで標準モジュールにコードを貼り付けてマクロを使用する方法はこちら

Word 非連続な位置にクリップボードのデータを貼り付ける

タイトルの通り、今回は Word の文書で非連続な位置にクリップボードのデータを貼り付けるということをやってみようと思います。

と、いっても非連続な位置に対してどうやってマクロで処理するのか・・・・・・。
少し考えた結果、以下のようにやってみることにしました。

まず、任意の位置に目印となる文字列を貼り付けておきます。ここでは、目印に (@_@;) を使っていますが、お好みで OK です。(Ctrl + V 等を使って効率よく貼り付けましょう)

f:id:kouten0430:20181006120939j:plain

 

次に、目印の位置に貼り付けるデータをクリップボードに取り込みます。
この状態で、後ほど掲載するマクロを実行します。

f:id:kouten0430:20181006121226j:plain

 

クリップボードデータの1行と、目印の1個が1対1の関係になっていることがポイントです。

 

コードはこちら。

Sub 非連続な位置にクリップボードのデータを貼り付け()
    'クリップボードのデータを貼り付ける位置にあらかじめ目印をつけておいて下さい
    '目印1個がクリップボードデータの1行分に対応します
    Dim Mejirushi As String
    Dim 全文字列 As String
    Dim 分割文字列 As Variant
    Dim i As Integer
    Dim myLib As Object
    Set myLib = CreateObject("new:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}")  '参照設定なしでDataObjectのインスタンスを生成する
    
    Mejirushi = "(@_@;)"  '検索する文字列(目印)
    
    myLib.GetFromClipboard
    
    On Error Resume Next
    
    全文字列 = myLib.GetText
    
    On Error GoTo 0
    
    If 全文字列 <> "" Then
        分割文字列 = Split(全文字列, vbCrLf)  '全文字列を改行で分割し、配列に格納する
        i = 0
        
        ActiveDocument.Range(0, 0).Select   '文書の先頭から検索を開始する
    
        With Selection.Find
            .Text = Mejirushi
            
            Do While .Execute   '検索に一致する文字列が無くなるまで下方向に検索する
                If i <= UBound(分割文字列) Then
                    Selection.Range.Text = 分割文字列(i)
                    i = i + 1
                Else
                    Selection.Range.Text = ""   '検索の途中で配列の中身が無くなった場合、余った目印は空白に置換する
                End If
            Loop

        End With
    
    Else
        MsgBox "クリップボードにデータがありません!"

    End If
    
End Sub

 

※コードの大まかな流れ

  • まず、クリップボードの全文字列を変数に格納します。
  • 次に、Split関数を使って全文字列を改行(CrLf)で分割し、配列に格納します。
  • Range(0, 0).Selectで、カーソルを文書の先頭に移動させます。
  • Selection.Findで、カーソル位置から検索開始とし(検索文字列は Text プロパティで指定)、Executeメソッドで検索を1回実行します。
  • 上記を、検索に一致する文字列が無くなるまでループさせます。(Executeメソッドが、検索に一致するものがあれば True を、無ければ False を返すので、これをループの継続条件に利用します)
  • ループ内の処理:検索に一致した文字列は選択状態になるので、配列の文字列と入れ替えます(次のループで、検索は下方向に、配列は次の要素に進みます)。検索の途中で配列の要素が尽きたら、余った目印は空白に置換(要するに削除)します。

 

※コードの使用方法

  • SubからEnd Subまでをコピーし、標準モジュール等に貼り付けて使用して下さい。なお、マクロで実行した処理は「元に戻す」ことができません。実行前に一旦保存し、やり直しのできる状態にしておいて下さい。Wordで標準モジュールにコードを貼り付けてマクロを使用する方法はこちら

Word 標準テンプレート(Normal.dotm)にVBAのコードを記述してマクロを使用するには

今回は Word で

  • VBEを起動する方法
  • 標準モジュールにコードを記述する方法
  • マクロを実行する方法

を順番に説明したいと思います。この辺は Excel とほとんど同じなので安心して下さい。

 

Word のデフォルトでは VBE を起動するためのボタンが非表示になっています。まずは VBE を起動できるように設定変更しましょう。リボンのタブ内のどこでもいいので右クリックして「リボンのユーザー設定」をクリックします。(ファイル-オプション-リボンのユーザー設定からでも同じように入れます)

リボンのユーザー設定を開いたら、「開発」にチェックを入れて OK します。

f:id:kouten0430:20181001125643j:plain

 

これでリボンに開発タブが追加されます。※画像の「Visual Basic」のボタンが VBE を起動するためのボタンです。

f:id:kouten0430:20181001125726j:plain

 

さっそく VBE を起動してみましょう。最初は標準モジュールが無い状態なので、左側のプロジェクトエクスプローラーで Normal を選択し「挿入」→「標準モジュール」で、標準モジュールを挿入します。

f:id:kouten0430:20181001130346j:plain

 

Normal は標準テンプレートと呼ばれ、エクセルでいうところの個人用マクロブックにあたります。なので、標準テンプレートに記述されたマクロは、すべての文書で共通して使用することができます。
C:\Users\ユーザー名\AppData\Roaming\Microsoft\Templates に、Normal.dotm というファイル名で用意されており、Word を起動するたびに自動的にロードされます。
VBA のコードの他に、フォント、余白、間隔、およびその他の設定が保存されています。

(それぞれの文書でのみ使用可能なマクロを記述する場合は、Project(文書1)などに標準モジュールを挿入し、コードを記述します)

 

さて、話を元に戻しましょう。
挿入された標準モジュールのコードウィンドウに、SubからEnd Subまでのコードを記述します。SubからEnd Subまでをプロシージャーといい、ざっくり言うとこれが一つのマクロの単位になります。

f:id:kouten0430:20181001130621j:plain

 

これで標準モジュールへ VBA コードの記述が完了しました。VBE を閉じて(右上の「×」を押す)、Word の画面に戻りましょう。

さきほど標準モジュールに記述したマクロを実行するには、開発タブから「マクロ」のボタンを押します。

f:id:kouten0430:20181001130752j:plain

 

すると、マクロの一覧が表示される(マクロの名前はプロシージャー名)ので、目的のマクロを選択して「実行」を押します。これで、SubからEnd Subまでの間に記述されたコードの内容が実行される(マクロが実行される)ことになります。 

f:id:kouten0430:20181001131502j:plain

 

ただし、その都度マクロの一覧から選択して実行するのは時間がかかるので、マクロをリボンやクイックアクセスツールバーに登録しておくと楽チンですよ。

 

マクロをリボンに登録する方法はこちら

kouten0430.hatenablog.com

 

マクロをクイックアクセスツールバーに登録する方法はこちら

kouten0430.hatenablog.com

非表示セルや結合セルを無かったことに・・・選択範囲を見たままコピペ

非表示セルや結合セルを含んだ範囲を普通にコピーし、他のセルへ値貼り付けしたら・・・・・・。

下のように、値が飛び飛びになってしまいます。

f:id:kouten0430:20180922133855j:plain

 

これを、マクロで飛び飛びにならないようにしてみましょう。

f:id:kouten0430:20180922134031j:plain

 

コードはこちらです。 

Sub Tab改行区切りでクリップボードに格納()
    Dim i As Long
    Dim j As Long
    Dim myLib As Object
    Set myLib = CreateObject("new:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}")  '参照設定なしでDataObjectのインスタンスを生成する
    
    If Selection.Areas.Count > 1 Then   '複数の矩形範囲が選択されている場合は終了する
        MsgBox "一つの矩形範囲のみ選択して再度実行して下さい。"
        Exit Sub
    End If

    For i = Selection.Row To Selection.Rows(Selection.Rows.Count).Row
        For j = Selection.Column To Selection.Columns(Selection.Columns.Count).Column
            If Cells(i, j).Address = Cells(i, j).MergeArea(1).Address And _
            Rows(i).Hidden = False And Columns(j).Hidden = False Then '結合セルの場合は左上の値のみ取り出す。非表示セルは処理しない
                If Cells(i, j).MergeArea(1).Address = Cells(i, Selection. _
                Columns(Selection.Columns.Count).Column).MergeArea(1).Address Then
                '選択範囲の最終列(最終列を含む結合セル)であれば末尾に改行を追加
                    If InStr(Cells(i, j), vbLf) = 0 Then
                        V = V & Cells(i, j).Value & vbCrLf
                    Else
                        V = V & """" & Cells(i, j).Value & """" & vbCrLf    'セル内改行があれば前後を""で囲む
                    End If
                Else
                '選択範囲の最終列(最終列を含む結合セル)以外は末尾にTabを追加
                    If InStr(Cells(i, j), vbLf) = 0 Then
                        V = V & Cells(i, j).Value & vbTab
                    Else
                        V = V & """" & Cells(i, j).Value & """" & vbTab   'セル内改行があれば前後を""で囲む
                    End If
                End If
            End If
        Next j
    Next i
    
    V = Left(V, Len(V) - 2) '最終行の改行区切りを取り除く(CrLfは2文字)
    
    myLib.SetText V  '変数の値をDataObjectに格納する
    myLib.PutInClipboard 'DataObjectのデータをクリップボードに格納する
    
End Sub

 

コピーしたい範囲を選択してから、マクロを実行します。

値が飛び飛びにならないよう加工され、クリップボードに転送されます。好きなセルへ値貼り付けして下さい。(コピーはマクロで、貼り付けは標準機能で行うという流れです)

 

※コードの大まかな説明

  • まず、複数の矩形範囲が選択されている場合は意図通りに処理することができないので、プロシージャを強制終了します。
  • 次に、下方向をi、右方向をjとして、選択範囲を左上から右下までループ処理します。処理内容は、各セルの値にTabまたは改行を付け足します。(列と列の間にはTabを、行と行の間には改行が入るようにする)
  • もし、上記の処理を非表示セルや結合セル(の左上以外)にも行うと・・・・・・最終的に下のようなデータが出来上がります。

    f:id:kouten0430:20180922134918j:plain

  • ・・・・・・が、これでは普通にコピーしたのと同じで、値貼り付けをすると「画像1」と同様になります。(逆にいうと、これが普通にコピーしたら飛び飛びになってしまう理由です)

  • なので、非表示セルや結合セル(の左上以外)には処理を行わないようにしましょう。そうすると、最終的に下のようなデータが出来上がります。

    f:id:kouten0430:20180922135300j:plain

  • これを値貼り付けすると「画像2」と同様になります。
  • 最後に、このデータをクリップボードへ転送します。

 

※コードの使用方法

  • SubからEnd Subまでをコピーし、標準モジュール等に貼り付けて使用して下さい。なお、マクロで実行した処理は「元に戻す」ことができません。実行前に一旦保存しやり直しのできる状態にしておいて下さい。標準モジュールにコードを貼り付けてマクロを使用する方法はこちら