Q&A
> PostgreSQLのテーブル「t_社員マスタ」にインポートするCSVファイルを作成するため、列を並び替えて「社員マスタ」に転記したいです。
投入後のテーブルで並びを指定すれば良いし、そもそもデータを投入する際の並びにを気にするのは何故ですか？
前提
Excelで社員名簿を出力するマクロを作っています。
ブックは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") '単価１ 44 .Offset(1, 29).Resize(LastRow - 1, 1).Copy wS2.Range("P3") '単価２ 45 .Offset(1, 30).Resize(LastRow - 1, 1).Copy wS2.Range("Q3") '単価３ 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～
>投入後のテーブルで並びを指定すれば良いし
PostgreSQLについて勉強不足なので申し訳ないですが、COPYコマンドでCSVファイルをインポートする際、SQL上で指定すれば並びが異なっていてもテーブルに合わせてデータを入れてくれる、ということでしょうか？？
参考までに「現在の社員名簿」は何行ありますか。
そして、実行時間はどのくらいかかっていますか。
現行のマクロでも、「配列に入れて一括で転記」と同等のことをやっているので、
これ以上速くするのは、無理かもしれません。
>参考までに「現在の社員名簿」は何行ありますか。
全部で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では遅くてコードが読みづらいという指摘を受けましたが、
これでも十分速いと考えて良いでしょうか。
>COPYでは遅くてコードが読みづらいという指摘を受けましたが、
>これでも十分速いと考えて良いでしょうか。
全然、問題ないと思います。
ちなみに、配列全体をセルへコピーする方法でやってみましたが、余計遅くなりました。
方法１
①「現在の社員名簿」全体（3行以降）を配列に格納する
②上記配列を別の配列（社員マスタ用のレイアウト）に転送
③別の配列（社員マスタ用のレイアウト）を社員マスタのセルに転送
（上記で③の箇所で時間がかかり、現行より遅くなりました）
方法２
①「現在の社員名簿」全体（3行以降）を配列に格納する
②上記配列の１列分を取り出し、それを新規の配列とし「社員マスタ」の該当列へ格納する
（但し、実務開始年月～所属営業所、退職年月日～経歴はその列数分を取り出し、新規の配列とする）
方法１、方法２のいずれも現行より遅くなっています。
よって、現行の方法が最適な方法と考えます。（私が思いつかないだけで他に方法があるかもしれませんが・・・）
ちなみにこちらの環境（現在の社員名簿の行数＝２２００行）で実行した結果の処理時間です。
現行 ０．６７秒
方法１ ２．３６秒
方法２ ２．４２秒
他に遅くなる可能性としてはコピーのたびに再計算が走るためが考えられます。
IndirectやOffsetのような揮発性関数がブックに含まれているとセルを更新するたびに再計算が行われます。その場合は自動計算をオフにすると改善します。
それでも駄目ならコピー先を飛び飛びの列ではなく隣接した列にして2次元配列を一気にコピーするのがいいと思います。
飛び飛びの列にしないといけない理由を潰してクリーンなデータに直すのもデータ処理では大事なことだと思います。
>>投入後のテーブルで並びを指定すれば良いし
>PostgreSQLについて勉強不足なので申し訳ないですが、COPYコマンドでCSVファイルをインポートする際、SQL上で指定すれば並びが異なっていてもテーブルに合わせてデータを入れてくれる、ということでしょうか？？
テーブルを参照する際にはその並び順を指定(order by)するのが基本です。
並びを指定しない場合、概ね格納した順となりますが、それはDBMS次第です。
なので、考え方が違います。
結局order by指定が優先されるので、格納順を工夫したとしても意味がありません。
>PostgreSQLについて勉強不足なので申し訳ないですが、COPYコマンドでCSVファイルをインポートする際、SQL上で指定すれば並びが異なっていてもテーブルに合わせてデータを入れてくれる、ということでしょうか？？
はい、そうなります。
例として
DBのテーブルに
社員番号、社員名、住所、年齢 順に列が定義されていて、
CSVファイルも、
社員番号、社員名、住所、年齢 の順に定義されている場合は、
COPYコマンドで 列（column）を指定しなくても、テーブルにそのまま取り込めます。
もし、CSVファイルの列の順序が、例えば、年齢、住所、社員名、社員番号の場合は、
COPYコマンドでこの列の順に列名を指定すれば、テーブルに取り込むことが可能です。
COPY テーブル名 ( 年齢の列名,住所の列名,社員名の列名,社員番号の列名 ) FROM CSVファイル名 WITH CSV;
のようになります。
但し、今回の場合、列が１５０列程あるかと思いますので、全ての列名をコマンドに書くのも、どうかと思いますので、現状の方法（テーブルの並び順にCSVファイルを出力）の方法で問題ないなら、現状のままの方が良いかと思います。
データの並びと勘違いしていました。
他の方も仰ってますが、テーブルの列の並びにファイルを合わせなくても、インポート時に指定が可能です。
>sazi様
>tatsu99様
>van2921様
コメントありがとうございます。
レビュー担当者に確認してもらいました。
飛び飛びの列になっている部分を整理するのは業務工程上時間がかかり、難しいので、
今回は皆さんのコメント通り、元のコードでCSVを作成することが決定しました。
細かく検証していただきありがとうございました。
回答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") '単価１ 55 ' .Offset(1, 29).Resize(LastRow - 1, 1).Copy wS2.Range("P3") '単価２ 56 ' .Offset(1, 30).Resize(LastRow - 1, 1).Copy wS2.Range("Q3") '単価３ 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) '単価１ 84 Call colcopy(31, 16, 1, arr, arr2) '単価２ 85 Call colcopy(32, 17, 1, arr, arr2) '単価３ 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
総合スコア5462
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
総合スコア47
あなたの回答
tips
プレビュー
