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

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

新規登録して質問してみよう
ただいま回答率
85.50%
VBA

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

Q&A

解決済

2回答

10767閲覧

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

WoodenHamlet

総合スコア306

VBA

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

1グッド

0クリップ

投稿2017/01/13 07:25

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

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

y軸反転の場合 a b c c b a d e f -> f e d g i i g

VBA

1Sub MirrorY() 2' 3' MirrorY Macro 4' 5 6 If TypeName(Selection) = "Range" Then 7 Application.ScreenUpdating = False 8 Application.Calculation = xlCalculationManual 9 10 Dim i, j, srcStart, srcEnd, srcStartRow, srcEndRow, dstStart, limit, hight As Integer 11 Dim srcArea, dstArea As Range 12 13 Set srcArea = Selection 14 limit = srcArea.Columns.Count 15 hight = srcArea.Rows.Count 16 srcEndRow = srcArea.Cells(srcArea.Count).Row 17 srcStartRow = srcArea.Row 18 19 Set dstArea = srcArea.Offset(, limit) 20 If WorksheetFunction.CountA(dstArea) = 0 Then 21 22 srcStart = srcArea.Column 23 srcEnd = srcStart + limit 24 dstStart = dstArea.Column 25 26 For i = 0 To limit 27 Range(Cells(srcStartRow, srcEnd - i), Cells(srcEndRow, srcEnd - i)).Select 28 Application.CutCopyMode = False 29 Selection.Copy 30 Cells(srcStartRow, dstStart + i).Select 31 ActiveSheet.Paste 32 Next i 33 Else 34 MsgBox "書込み範囲が空白ではありません" 35 End If 36 Application.ScreenUpdating = True 37 Application.Calculation = xlCalculationAutomatic 38 End If 39End 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
Wolf👍を押しています

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

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

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

バッドをするには、ログインかつ

こちらの条件を満たす必要があります。

guest

回答2

0

ベストアンサー

こんばんは。

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

↓ご参考。

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 09:31

Wolf

総合スコア38

バッドをするには、ログインかつ

こちらの条件を満たす必要があります。

WoodenHamlet

2017/01/13 10:11

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

0

データ(セルの中身)を移すだけで、データの書式(色、文字の大きさやフォント等)を保つ必要がないのであれば、セルの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

投稿2017/01/13 09:10

coco_bauer

総合スコア6915

バッドをするには、ログインかつ

こちらの条件を満たす必要があります。

あなたの回答

tips

太字

斜体

打ち消し線

見出し

引用テキストの挿入

コードの挿入

リンクの挿入

リストの挿入

番号リストの挿入

表の挿入

水平線の挿入

プレビュー

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

ただいまの回答率
85.50%

質問をまとめることで
思考を整理して素早く解決

テンプレート機能で
簡単に質問をまとめる

質問する

関連した質問