質問をすることでしか得られない、回答やアドバイスがある。

15分調べてもわからないことは、質問しよう!

ただいまの
回答率

90.45%

  • VBA

    2397questions

    VBAはオブジェクト指向プログラミング言語のひとつで、マクロを作成によりExcelなどのOffice業務を自動化することができます。

  • Excel

    1974questions

    Excelは、マイクロソフト社が開発しているデータ集計や分析を行う表計算ソフトの一つです。文書作成や表計算、資料作成などの多彩な機能を備えており、統合パッケージであるMicrosoft Officeに含まれています。

エクセル:指定範囲の反転データを作成する

解決済

回答 2

投稿

  • 評価
  • クリップ 0
  • VIEW 3,430

WoodenHamlet

score 147

VBAを用いて指定した範囲内のデータをx, y軸に対して線対象なデータをプロットするマクロを作成しました。
私はVBAを触ったことがなかったので、ネットの情報を見ながら試行錯誤で組んだのですが、期待する動きはするものの動作が重く感じます。
どうすればより早く動作するマクロにできますでしょうか?
また、エクセル上ではなくクリップボードに線対象なデータを持たせることは可能でしょうか?

期待する動作は、以下の図上、左側の3*3マトリクスを選択して
マクロを走らせると右側のデータがプロットされる動きです。

y軸反転の場合
a b c      c b a
d e f  ->  f e d
g   i      i   g
Sub MirrorY()
'
' MirrorY Macro
'

    If TypeName(Selection) = "Range" Then
        Application.ScreenUpdating = False
        Application.Calculation = xlCalculationManual

        Dim i, j, srcStart, srcEnd, srcStartRow, srcEndRow, dstStart, limit, hight As Integer
        Dim srcArea, dstArea As Range

        Set srcArea = Selection
        limit = srcArea.Columns.Count
        hight = srcArea.Rows.Count
        srcEndRow = srcArea.Cells(srcArea.Count).Row
        srcStartRow = srcArea.Row

        Set dstArea = srcArea.Offset(, limit)
        If WorksheetFunction.CountA(dstArea) = 0 Then

            srcStart = srcArea.Column
            srcEnd = srcStart + limit
            dstStart = dstArea.Column

            For i = 0 To limit
                Range(Cells(srcStartRow, srcEnd - i), Cells(srcEndRow, srcEnd - i)).Select
                Application.CutCopyMode = False
                Selection.Copy
                Cells(srcStartRow, dstStart + i).Select
                ActiveSheet.Paste
            Next i
        Else
            MsgBox "書込み範囲が空白ではありません"
        End If
        Application.ScreenUpdating = True
        Application.Calculation = xlCalculationAutomatic
    End If
End Sub
Sub MirrorX()
'
' MirrorX Macro
'

'
    If TypeName(Selection) = "Range" Then
        Application.ScreenUpdating = False
        Application.Calculation = xlCalculationManual


        Dim i, j, srcStart, srcEnd, srcStartCol, srcEndCol, dstStart, limit, width As Integer
        Dim srcArea, dstArea As Range

        Set srcArea = Selection
        limit = srcArea.Rows.Count
        width = srcArea.Columns.Count
        srcEndCol = srcArea.Cells(srcArea.Count).Column
        srcStartCol = srcArea.Column

        Set dstArea = srcArea.Offset(limit)

        If WorksheetFunction.CountA(dstArea) = 0 Then

            srcStart = srcArea.Row
            srcEnd = srcStart + limit
            dstStart = dstArea.Row

            For i = 0 To limit
                Range(Cells(srcEnd - i, srcStartCol), Cells(srcEnd - i, srcEndCol)).Select
                Application.CutCopyMode = False
                Selection.Copy
                Cells(dstStart + i, srcStartCol).Select
                ActiveSheet.Paste
            Next i

        Else
            MsgBox "書込み範囲が空白ではありません"
        End If

        Application.ScreenUpdating = True
        Application.Calculation = xlCalculationAutomatic
    End If

End Sub
  • 気になる質問をクリップする

    クリップした質問は、後からいつでもマイページで確認できます。

    またクリップした質問に回答があった際、通知やメールを受け取ることができます。

    クリップを取り消します

  • 良い質問の評価を上げる

    以下のような質問は評価を上げましょう

    • 質問内容が明確
    • 自分も答えを知りたい
    • 質問者以外のユーザにも役立つ

    評価が高い質問は、TOPページの「注目」タブのフィードに表示されやすくなります。

    質問の評価を上げたことを取り消します

  • 評価を下げられる数の上限に達しました

    評価を下げることができません

    • 1日5回まで評価を下げられます
    • 1日に1ユーザに対して2回まで評価を下げられます

    質問の評価を下げる

    teratailでは下記のような質問を「具体的に困っていることがない質問」、「サイトポリシーに違反する質問」と定義し、推奨していません。

    • プログラミングに関係のない質問
    • やってほしいことだけを記載した丸投げの質問
    • 問題・課題が含まれていない質問
    • 意図的に内容が抹消された質問
    • 広告と受け取られるような投稿

    評価が下がると、TOPページの「アクティブ」「注目」タブのフィードに表示されにくくなります。

    質問の評価を下げたことを取り消します

    この機能は開放されていません

    評価を下げる条件を満たしてません

    評価を下げる理由を選択してください

    詳細な説明はこちら

    上記に当てはまらず、質問内容が明確になっていない質問には「情報の追加・修正依頼」機能からコメントをしてください。

    質問の評価を下げる機能の利用条件

    この機能を利用するためには、以下の事項を行う必要があります。

回答 2

checkベストアンサー

+1

こんばんは。

コピーとペーストを繰り返すコードとお見受けしますが、値をひっくり返すだけであれば、
配列を用いた方が簡単で早いかもしれません。

↓ご参考。

Sub MirrorY_Sample()

Dim buf1    As Variant
Dim buf2    As Variant
Dim x_Max   As Long
Dim y_Max   As Long
Dim i       As Long
Dim j       As Long

buf1 = Selection

x_Max = UBound(buf1, 2)
y_Max = UBound(buf1, 1)

ReDim buf2(1 To y_Max, 1 To x_Max)

For i = 1 To y_Max
For j = 1 To x_Max
buf2(i, j) = buf1(i, x_Max - j + 1)
Next j
Next i

Selection(1).Offset(, x_Max + 2).Resize(y_Max, x_Max) = buf2

End Sub

クリップボードについて、Microsoft Forms 2.0 Object Libraryを参照設定して値を持たせようとしたのですが、私の力量不足で、これは上手くいきませんでした。お力になれず、申し訳ありません。

以上、参考まで。

投稿

  • 回答の評価を上げる

    以下のような回答は評価を上げましょう

    • 正しい回答
    • わかりやすい回答
    • ためになる回答

    評価が高い回答ほどページの上位に表示されます。

  • 回答の評価を下げる

    下記のような回答は推奨されていません。

    • 間違っている回答
    • 質問の回答になっていない投稿
    • スパムや攻撃的な表現を用いた投稿

    評価を下げる際はその理由を明確に伝え、適切な回答に修正してもらいましょう。

  • 2017/01/13 19:11

    とても参考になりました!ありがとうございます。私のコードとは比べ物にならないほど速くなりました!よく使うことになるマクロなので、本当に助かりました。

    キャンセル

+1

データ(セルの中身)を移すだけで、データの書式(色、文字の大きさやフォント等)を保つ必要がないのであれば、セルのCopy & Pasteよりもデータの代入で処理する方が速いです。
Copy & Pasteだと、"元のセル ー> クリップボード"、"クリップボード ー> 行き先のセル"、の2動作になりますが、代入であれば"元のセル ー> 行き先のセル"の1動作ですむからです。

質問のコードを代入を使うように変更すると、以下のような感じになります。(書き込み先のセルが空白かどうか判断する部分は、本質ではないので省略させてもらいました)

Sub MirrorY_modified()
'
' MirrorY Macro 変更版
'
    Dim srcArea As Range, width As Integer, hight As Integer
    Dim rowBegin As Integer, colBegin As Integer, colEnd As Integer
    Dim r As Integer, c As Integer


    If TypeName(Selection) = "Range" Then
        Application.ScreenUpdating = False
        Application.Calculation = xlCalculationManual

        Set srcArea = Selection
        width = srcArea.Columns.Count  '反転する領域の幅(列数)
        hight = srcArea.Rows.Count      '反転する領域の高さ(行数)
        rowBegin = srcArea.row '操作を始める行
        colBegin = srcArea.Column '操作を始める元のデータの列(最初の列)
        colEnd = colBegin + (width * 2) '操作を始める移し先のデータの列(最後の列)

        For r = rowBegin To rowBegin + hight - 1 '行のループ
          For c = 0 To width - 1 '列のループ
            Cells(r, colEnd - c) = Cells(r, colBegin + c)
          Next c
        Next r

        Application.ScreenUpdating = True
        Application.Calculation = xlCalculationAutomatic
    End If
End Sub

投稿

  • 回答の評価を上げる

    以下のような回答は評価を上げましょう

    • 正しい回答
    • わかりやすい回答
    • ためになる回答

    評価が高い回答ほどページの上位に表示されます。

  • 回答の評価を下げる

    下記のような回答は推奨されていません。

    • 間違っている回答
    • 質問の回答になっていない投稿
    • スパムや攻撃的な表現を用いた投稿

    評価を下げる際はその理由を明確に伝え、適切な回答に修正してもらいましょう。

15分調べてもわからないことは、teratailで質問しよう!

  • ただいまの回答率 90.45%
  • 質問をまとめることで、思考を整理して素早く解決
  • テンプレート機能で、簡単に質問をまとめられる

同じタグがついた質問を見る

  • VBA

    2397questions

    VBAはオブジェクト指向プログラミング言語のひとつで、マクロを作成によりExcelなどのOffice業務を自動化することができます。

  • Excel

    1974questions

    Excelは、マイクロソフト社が開発しているデータ集計や分析を行う表計算ソフトの一つです。文書作成や表計算、資料作成などの多彩な機能を備えており、統合パッケージであるMicrosoft Officeに含まれています。