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

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

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

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

Q&A

解決済

2回答

979閲覧

【VBA】テーブル列を並び替えて別シートに高速でコピー貼り付けしたい

koburon

総合スコア29

VBA

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

0グッド

0クリップ

投稿2023/02/15 06:34

前提

Excelで社員名簿を出力するマクロを作っています。
ブックは1つで複数のシートを連携させて社員名簿を出力します。
今回は以下の2枚のシートを使用したコードに関する質問です。

  1. 現在の社員名簿
  2. 社員マスタ

実現したいこと

「現在の社員名簿」に社員番号や氏名、部署等をまとめていますが、PostgreSQLのテーブル「t_社員マスタ」にインポートするCSVファイルを作成するため、列を並び替えて「社員マスタ」に転記したいです。

該当のソースコード

VBA

1Sub Copy_master() 2 '社員名簿をコピーして社員マスタに貼り付け 3 Application.ScreenUpdating = False 4 5 Dim wS1 As Worksheet 6 Dim wS2 As Worksheet 7 Dim LastRow As Long 8 9 'ワークシートを変数で宣言する 10 Set wS1 = Worksheets("現在の社員名簿") 11 Set wS2 = Worksheets("社員マスタ") 12 13 '最終行を取得 14 LastRow = wS1.Cells(Rows.Count, "A").End(xlUp).Row 15 16 '3行目以降をクリアする 17 wS2.Rows("3:" & Rows.Count).ClearContents 18 19 '値をコピーして貼り付ける 20 With wS1.Range("A2").CurrentRegion.Range("B2") 21 .Offset(1, 0).Resize(LastRow - 1, 1).Copy wS2.Range("A3") '社員番号 22 .Offset(1, 1).Resize(LastRow - 1, 1).Copy wS2.Range("G3") '支社 23 .Offset(1, 6).Resize(LastRow - 1, 1).Copy wS2.Range("EM3") '経歴 24 .Offset(1, 8).Resize(LastRow - 1, 1).Copy wS2.Range("J3") '役職名 25 .Offset(1, 10).Resize(LastRow - 1, 1).Copy wS2.Range("B3") '氏名 26 .Offset(1, 11).Resize(LastRow - 1, 1).Copy wS2.Range("C3") '氏名カナ 27 .Offset(1, 12).Resize(LastRow - 1, 1).Copy wS2.Range("R3") '生年月日 28 .Offset(1, 13).Resize(LastRow - 1, 1).Copy wS2.Range("AI3") '入社年月日 29 .Offset(1, 14).Resize(LastRow - 1, 1).Copy wS2.Range("EN3") 'メールアドレス 30 .Offset(1, 15).Resize(LastRow - 1, 1).Copy wS2.Range("S3") '学歴(学校名) 31 .Offset(1, 16).Resize(LastRow - 1, 1).Copy wS2.Range("T3") '学部・学科 32 .Offset(1, 17).Resize(LastRow - 1, 1).Copy wS2.Range("U3") '卒業年月 33 .Offset(1, 18).Resize(LastRow - 1, 1).Copy wS2.Range("W3") '大学卒業区分 34 .Offset(1, 19).Resize(LastRow - 1, 1).Copy wS2.Range("F3") '支社コード 35 .Offset(1, 20).Resize(LastRow - 1, 1).Copy wS2.Range("E3") '所属 36 .Offset(1, 21).Resize(LastRow - 1, 1).Copy wS2.Range("D3") '所属コード 37 .Offset(1, 22).Resize(LastRow - 1, 1).Copy wS2.Range("H3") 'クラス 38 .Offset(1, 23).Resize(LastRow - 1, 1).Copy wS2.Range("I3") '管理職F 39 .Offset(1, 24).Resize(LastRow - 1, 1).Copy wS2.Range("K3") '直間F 40 .Offset(1, 25).Resize(LastRow - 1, 1).Copy wS2.Range("L3") '社内外F 41 .Offset(1, 26).Resize(LastRow - 1, 1).Copy wS2.Range("M3") '基準内単価 42 .Offset(1, 27).Resize(LastRow - 1, 1).Copy wS2.Range("N3") '残業単価 43 .Offset(1, 28).Resize(LastRow - 1, 1).Copy wS2.Range("O3") '単価1 44 .Offset(1, 29).Resize(LastRow - 1, 1).Copy wS2.Range("P3") '単価2 45 .Offset(1, 30).Resize(LastRow - 1, 1).Copy wS2.Range("Q3") '単価3 46 .Offset(1, 31).Resize(LastRow - 1, 1).Copy wS2.Range("V3") '大学卒業区分コード 47 .Offset(1, 32).Resize(LastRow - 1, 11).Copy wS2.Range("X3") '実務開始年月~所属営業所 48 .Offset(1, 43).Resize(LastRow - 1, 107).Copy wS2.Range("AJ3") '退職年月日~経歴 49 End With 50 51 'セル範囲を線で囲む 52 wS2.Range("A3:EN" & LastRow).Borders.LineStyle = xlLineStyleNone 53 54 'A1セルにタイトルをつける 55 wS2.Range("a1") = "今日現在の社員マスタ" 56 57 Application.ScreenUpdating = True 58 59End Sub

発生している問題

元シートと転記シートの列がバラバラなので、OffsetとResizeを使用してCopy関数でセル値をコピー貼り付けしています。
もちろんこのコードでも問題なく並び替えはできますが、セルのコピーに関するコードを調べると、通常の「COPY」では遅く、「配列に入れて一括で転記」する方が速いと書かれていたので、なるべく速く処理できるコードに修正したいです。

Excel VBA 遅いコピー貼り付けを高速コピー貼り付けする方法

試したこと

上記のURLなど「配列に格納して転記するコード」が載っているサイトでは、1列だけの場合や、複数列でも元シートと転記先シートの列の配置を揃えている場合がほとんどでした。
やはり元シート「現在の社員名簿」の時点で列を並び替えておく方が良いでしょうか。
できれば元シートの並びを変えない状態から少ないコードで済む設定について、ご教示いただければと思います。
よろしくお願いいたします。

補足情報(FW/ツールのバージョンなど)

PC:Windows11
ソフト:Microsoft365 Excel
参考URL:社員名簿を作る ~その3~

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

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

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

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

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

sazi

2023/02/15 09:00

> PostgreSQLのテーブル「t_社員マスタ」にインポートするCSVファイルを作成するため、列を並び替えて「社員マスタ」に転記したいです。 投入後のテーブルで並びを指定すれば良いし、そもそもデータを投入する際の並びにを気にするのは何故ですか?
koburon

2023/02/15 09:07 編集

>投入後のテーブルで並びを指定すれば良いし PostgreSQLについて勉強不足なので申し訳ないですが、COPYコマンドでCSVファイルをインポートする際、SQL上で指定すれば並びが異なっていてもテーブルに合わせてデータを入れてくれる、ということでしょうか??
tatsu99

2023/02/16 05:10

参考までに「現在の社員名簿」は何行ありますか。 そして、実行時間はどのくらいかかっていますか。 現行のマクロでも、「配列に入れて一括で転記」と同等のことをやっているので、 これ以上速くするのは、無理かもしれません。
koburon

2023/02/16 06:10

>参考までに「現在の社員名簿」は何行ありますか。 全部で2190行、151列です。 >そして、実行時間はどのくらいかかっていますか。 With ~ End Withの前後に以下の変数と処理を追加して計測してみました。 Dim startTime As Double Dim endTime As Double Dim processTime As Double '開始時間取得 startTime = Timer With End With '終了時間取得 endTime = Timer '処理時間計算 processTime = endTime - startTime MsgBox "処理時間:" & processTime 結果は「処理時間:0.52734375」でした。 COPYでは遅くてコードが読みづらいという指摘を受けましたが、 これでも十分速いと考えて良いでしょうか。
tatsu99

2023/02/16 08:49

>COPYでは遅くてコードが読みづらいという指摘を受けましたが、 >これでも十分速いと考えて良いでしょうか。 全然、問題ないと思います。 ちなみに、配列全体をセルへコピーする方法でやってみましたが、余計遅くなりました。 方法1 ①「現在の社員名簿」全体(3行以降)を配列に格納する ②上記配列を別の配列(社員マスタ用のレイアウト)に転送 ③別の配列(社員マスタ用のレイアウト)を社員マスタのセルに転送 (上記で③の箇所で時間がかかり、現行より遅くなりました) 方法2 ①「現在の社員名簿」全体(3行以降)を配列に格納する ②上記配列の1列分を取り出し、それを新規の配列とし「社員マスタ」の該当列へ格納する (但し、実務開始年月~所属営業所、退職年月日~経歴はその列数分を取り出し、新規の配列とする) 方法1、方法2のいずれも現行より遅くなっています。 よって、現行の方法が最適な方法と考えます。(私が思いつかないだけで他に方法があるかもしれませんが・・・)
tatsu99

2023/02/16 08:53

ちなみにこちらの環境(現在の社員名簿の行数=2200行)で実行した結果の処理時間です。 現行 0.67秒 方法1 2.36秒 方法2 2.42秒
vann_2921

2023/02/16 15:08 編集

他に遅くなる可能性としてはコピーのたびに再計算が走るためが考えられます。 IndirectやOffsetのような揮発性関数がブックに含まれているとセルを更新するたびに再計算が行われます。その場合は自動計算をオフにすると改善します。 それでも駄目ならコピー先を飛び飛びの列ではなく隣接した列にして2次元配列を一気にコピーするのがいいと思います。 飛び飛びの列にしないといけない理由を潰してクリーンなデータに直すのもデータ処理では大事なことだと思います。
sazi

2023/02/17 01:13 編集

>>投入後のテーブルで並びを指定すれば良いし >PostgreSQLについて勉強不足なので申し訳ないですが、COPYコマンドでCSVファイルをインポートする際、SQL上で指定すれば並びが異なっていてもテーブルに合わせてデータを入れてくれる、ということでしょうか?? テーブルを参照する際にはその並び順を指定(order by)するのが基本です。 並びを指定しない場合、概ね格納した順となりますが、それはDBMS次第です。 なので、考え方が違います。 結局order by指定が優先されるので、格納順を工夫したとしても意味がありません。
tatsu99

2023/02/19 13:01 編集

>PostgreSQLについて勉強不足なので申し訳ないですが、COPYコマンドでCSVファイルをインポートする際、SQL上で指定すれば並びが異なっていてもテーブルに合わせてデータを入れてくれる、ということでしょうか?? はい、そうなります。 例として DBのテーブルに 社員番号、社員名、住所、年齢 順に列が定義されていて、 CSVファイルも、 社員番号、社員名、住所、年齢 の順に定義されている場合は、 COPYコマンドで 列(column)を指定しなくても、テーブルにそのまま取り込めます。 もし、CSVファイルの列の順序が、例えば、年齢、住所、社員名、社員番号の場合は、 COPYコマンドでこの列の順に列名を指定すれば、テーブルに取り込むことが可能です。 COPY テーブル名 ( 年齢の列名,住所の列名,社員名の列名,社員番号の列名 ) FROM CSVファイル名 WITH CSV; のようになります。 但し、今回の場合、列が150列程あるかと思いますので、全ての列名をコマンドに書くのも、どうかと思いますので、現状の方法(テーブルの並び順にCSVファイルを出力)の方法で問題ないなら、現状のままの方が良いかと思います。
sazi

2023/02/20 06:55

データの並びと勘違いしていました。 他の方も仰ってますが、テーブルの列の並びにファイルを合わせなくても、インポート時に指定が可能です。
koburon

2023/02/20 07:13

>sazi様 >tatsu99様 >van2921様 コメントありがとうございます。 レビュー担当者に確認してもらいました。 飛び飛びの列になっている部分を整理するのは業務工程上時間がかかり、難しいので、 今回は皆さんのコメント通り、元のコードでCSVを作成することが決定しました。 細かく検証していただきありがとうございました。
guest

回答2

0

ベストアンサー

回答ではありません。
①「現在の社員名簿」全体(3行以降)を配列に格納する
②上記配列を別の配列(社員マスタ用のレイアウト)に転送
③別の配列(社員マスタ用のレイアウト)を社員マスタのセルに転送
を行った時のマクロです。
③の箇所で遅くなっています。
ソース上のwS2.Range("A3:" & ecol & LastRow) = arr2の箇所です。
t2とt3の差がその時間になります。(MsgBox (t3 - t2 & "秒")を実行するとその時間が判ります)
結局、あなたから提示されたマクロより遅くなるので、「配列に入れて一括で転記」したからと言って、速くなるわけではない。ということの証拠にはなるかと思います。

VBA

1Sub Copy_master2() 2 Const S2MAXCOL = 144 3 Dim arr As Variant 4 Dim arr2 As Variant 5 Dim t0 As Double 6 Dim t1 As Double 7 Dim t2 As Double 8 Dim t3 As Double 9 Dim t4 As Double 10 t0 = Timer 11 '社員名簿をコピーして社員マスタに貼り付け 12 Application.ScreenUpdating = False 13 14 Dim wS1 As Worksheet 15 Dim wS2 As Worksheet 16 Dim LastRow As Long 17 18 'ワークシートを変数で宣言する 19 Set wS1 = Worksheets("現在の社員名簿") 20 Set wS2 = Worksheets("社員マスタ") 21 22 '最終行を取得 23 LastRow = wS1.Cells(Rows.Count, "A").End(xlUp).Row 24 25 '3行目以降をクリアする 26 wS2.Rows("3:" & Rows.Count).ClearContents 27 arr = wS1.Range("A3:FD" & LastRow) 28 ReDim arr2(1 To UBound(arr, 1), 1 To S2MAXCOL) 29 t1 = Timer 30 '値をコピーして貼り付ける 31 ' With wS1.Range("A2").CurrentRegion.Range("B2") 32 ' .Offset(1, 0).Resize(LastRow - 1, 1).Copy wS2.Range("A3") '社員番号 33 ' .Offset(1, 1).Resize(LastRow - 1, 1).Copy wS2.Range("G3") '支社 34 ' .Offset(1, 6).Resize(LastRow - 1, 1).Copy wS2.Range("EM3") '経歴 35 ' .Offset(1, 8).Resize(LastRow - 1, 1).Copy wS2.Range("J3") '役職名 36 ' .Offset(1, 10).Resize(LastRow - 1, 1).Copy wS2.Range("B3") '氏名 37 ' .Offset(1, 11).Resize(LastRow - 1, 1).Copy wS2.Range("C3") '氏名カナ 38 ' .Offset(1, 12).Resize(LastRow - 1, 1).Copy wS2.Range("R3") '生年月日 39 ' .Offset(1, 13).Resize(LastRow - 1, 1).Copy wS2.Range("AI3") '入社年月日 40 ' .Offset(1, 14).Resize(LastRow - 1, 1).Copy wS2.Range("EN3") 'メールアドレス 41 ' .Offset(1, 15).Resize(LastRow - 1, 1).Copy wS2.Range("S3") '学歴(学校名) 42 ' .Offset(1, 16).Resize(LastRow - 1, 1).Copy wS2.Range("T3") '学部・学科 43 ' .Offset(1, 17).Resize(LastRow - 1, 1).Copy wS2.Range("U3") '卒業年月 44 ' .Offset(1, 18).Resize(LastRow - 1, 1).Copy wS2.Range("W3") '大学卒業区分 45 ' .Offset(1, 19).Resize(LastRow - 1, 1).Copy wS2.Range("F3") '支社コード 46 ' .Offset(1, 20).Resize(LastRow - 1, 1).Copy wS2.Range("E3") '所属 47 ' .Offset(1, 21).Resize(LastRow - 1, 1).Copy wS2.Range("D3") '所属コード 48 ' .Offset(1, 22).Resize(LastRow - 1, 1).Copy wS2.Range("H3") 'クラス 49 ' .Offset(1, 23).Resize(LastRow - 1, 1).Copy wS2.Range("I3") '管理職F 50 ' .Offset(1, 24).Resize(LastRow - 1, 1).Copy wS2.Range("K3") '直間F 51 ' .Offset(1, 25).Resize(LastRow - 1, 1).Copy wS2.Range("L3") '社内外F 52 ' .Offset(1, 26).Resize(LastRow - 1, 1).Copy wS2.Range("M3") '基準内単価 53 ' .Offset(1, 27).Resize(LastRow - 1, 1).Copy wS2.Range("N3") '残業単価 54 ' .Offset(1, 28).Resize(LastRow - 1, 1).Copy wS2.Range("O3") '単価1 55 ' .Offset(1, 29).Resize(LastRow - 1, 1).Copy wS2.Range("P3") '単価2 56 ' .Offset(1, 30).Resize(LastRow - 1, 1).Copy wS2.Range("Q3") '単価3 57 ' .Offset(1, 31).Resize(LastRow - 1, 1).Copy wS2.Range("V3") '大学卒業区分コード 58 ' .Offset(1, 32).Resize(LastRow - 1, 11).Copy wS2.Range("X3") '実務開始年月~所属営業所 59 ' .Offset(1, 43).Resize(LastRow - 1, 107).Copy wS2.Range("AJ3") '退職年月日~経歴 60 ' End With 61 Call colcopy(2, 1, 1, arr, arr2) '社員番号 62 Call colcopy(3, 7, 1, arr, arr2) '支社 63 Call colcopy(8, 143, 1, arr, arr2) '経歴 64 Call colcopy(10, 10, 1, arr, arr2) '役職名 65 Call colcopy(12, 2, 1, arr, arr2) '氏名 66 Call colcopy(13, 3, 1, arr, arr2) '氏名カナ 67 Call colcopy(14, 18, 1, arr, arr2) '生年月日 68 Call colcopy(15, 35, 1, arr, arr2) '入社年月日 69 Call colcopy(16, 144, 1, arr, arr2) 'メールアドレス 70 Call colcopy(17, 19, 1, arr, arr2) '学歴(学校名) 71 Call colcopy(18, 20, 1, arr, arr2) '学部・学科 72 Call colcopy(19, 21, 1, arr, arr2) '卒業年月 73 Call colcopy(20, 23, 1, arr, arr2) '大学卒業区分 74 Call colcopy(21, 6, 1, arr, arr2) '支社コード 75 Call colcopy(22, 5, 1, arr, arr2) '所属 76 Call colcopy(23, 4, 1, arr, arr2) '所属コード 77 Call colcopy(24, 8, 1, arr, arr2) 'クラス 78 Call colcopy(25, 9, 1, arr, arr2) '管理職F 79 Call colcopy(26, 11, 1, arr, arr2) '直間F 80 Call colcopy(27, 12, 1, arr, arr2) '社内外F 81 Call colcopy(28, 13, 1, arr, arr2) '基準内単価 82 Call colcopy(29, 14, 1, arr, arr2) '残業単価 83 Call colcopy(30, 15, 1, arr, arr2) '単価1 84 Call colcopy(31, 16, 1, arr, arr2) '単価2 85 Call colcopy(32, 17, 1, arr, arr2) '単価3 86 Call colcopy(33, 22, 1, arr, arr2) '大学卒業区分コード 87 Call colcopy(34, 24, 11, arr, arr2) '実務開始年月~所属営業所 88 Call colcopy(45, 36, 107, arr, arr2) '退職年月日~経歴 89 t2 = Timer 90 91 Dim ecol As String: ecol = ConvertToLetter(S2MAXCOL) 92 'ここで時間がかかる 93 wS2.Range("A3:" & ecol & LastRow) = arr2 94 t3 = Timer 95 'セル範囲を線で囲む 96 wS2.Range("A3:EN" & LastRow).Borders.LineStyle = xlLineStyleNone 97 98 'A1セルにタイトルをつける 99 wS2.Range("a1") = "今日現在の社員マスタ" 100 101 Application.ScreenUpdating = True 102 t4 = Timer 103 MsgBox ("copy2完了 " & t4 - t0 & "秒") 104 ' MsgBox (t1 - t0 & "秒") 105 ' MsgBox (t2 - t1 & "秒") 106 ' MsgBox (t3 - t2 & "秒") 107 ' MsgBox (t4 - t3 & "秒") 108End Sub 109 110Private Sub colcopy(ByVal sx As Long, ByVal tx As Long, ByVal num_col As Long, arr As Variant, arr2 As Variant) 111 Dim i As Long 112 Dim j As Long 113 For j = 0 To num_col - 1 114 For i = 1 To UBound(arr, 1) 115 arr2(i, tx + j) = arr(i, sx + j) 116 Next 117 Next 118End Sub 119'カラム番号を文字に変換する 120Function ConvertToLetter(ByVal iCol As Long) As String 121 Dim iAlpha As Long 122 Dim iRemainder As Long 123 iAlpha = Int((iCol - 1) / 26) 124 iRemainder = iCol - (iAlpha * 26) 125 If iAlpha > 0 Then 126 ConvertToLetter = Chr(iAlpha + 64) 127 End If 128 If iRemainder > 0 Then 129 ConvertToLetter = ConvertToLetter & Chr(iRemainder + 64) 130 End If 131End Function 132

投稿2023/02/17 10:09

tatsu99

総合スコア5438

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

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

koburon

2023/02/20 07:15

検証していただいた内容が最も参考になりましたので、 回答ではないとのことですが、こちらをベストアンサーとさせていただきます。 ありがとうございました。
guest

0

私もド素人でVBAもそんなに詳しくなくてPostgreSQLというものも知らないのですが、最初からCSV作るのはマズイのですか?

VBA

1Sub Test() 2 Dim MyPath As String 3 Dim wS1 As Worksheet 4 Dim i As Long 5 Dim LastRow As Long 6 Dim buf As String 7 8 9 MyPath = "保存先のフォルダ" & Format(Date, "yyyymmdd") & "今日現在の社員マスタ.csv" 10 CreateObject("Scripting.FileSystemObject").CreateTextFile (MyPath) 11 12 Set wS1 = Worksheets("現在の社員名簿") 13 14 LastRow = wS1.Cells(Rows.Count, 1).End(xlUp).Row 15 16 Open MyPath For Append As #1 17 For i = 2 To LastRow 18 'ここからテキトウ---------------------------------- 19 buf = wS1.Cells(i, 1).Value 20 buf = buf & "," & wS1.Cells(i, 2).Value 21 buf = buf & "," & wS1.Cells(i, 3).Value 22 buf = buf & "," & wS1.Cells(i, 4).Value 23 '省略 24 buf = buf & "," & wS1.Cells(i, 27).Value 25 'ここまでテキトウ---------------------------------- 26 Print #1, buf 27 Next i 28 Close #1 29 30End Sub

投稿2023/02/18 06:44

Black_Velvet

総合スコア47

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

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

あなたの回答

tips

太字

斜体

打ち消し線

見出し

引用テキストの挿入

コードの挿入

リンクの挿入

リストの挿入

番号リストの挿入

表の挿入

水平線の挿入

プレビュー

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

ただいまの回答率
85.49%

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

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

質問する

関連した質問