解析エンジニアの自動化 blog

コツコツと自動化した方法を残す blog

投資戦略、営業戦略の自動化




こんにちは。
仕事の自動化にやりがいと達成感を感じるガッくんです。




この記事の目次




目的


企業の情報の調べ方を整理して、業界動向、企業動向、投資戦略、営業戦略に役立てる方法を整理する。




会社の情報の調べ方

着目した情報

業界動向、企業動向などははどうしたら分かるのか…と考えたところ着目するべき情報として株式の情報があるかなぁっと思いました。

業界を捉えるなら、日経平均株価の算出の元になっている企業の業績を調べればいいのかなと。

日経平均株価の算出元の企業を業界別に分けて、業界別の株価の変動等を捉えられれば業界の傾向が分かるのではないかなぁと考えました。

これは企業動向を寄せ集めれば業界動向になるといった考え方になると思ってます。

企業動向

それでは企業動向はどうしたら分かるのかというと…よく分かっていません。

株価で言えば目先の利益(短時間における利益)になればなるほど投資家の人達はテクニカル分析と言われるもので判断されているのではないでしょうか?よく知りませんけど(笑)

もちろん、企業のホームページなどを見ているとプレスリリースやニュースといった情報を発信しているので、その情報から企業価値、将来性などに投資をしている人達も多くいるとは思います。

人々が企業の発信する情報に対し、何を思うのかというと抽象的なことをプログラムに理解させて、即座に企業価値を数値化していくことが良いのかと思います。

業界動向

着目した情報でも書いた通り、企業動向を業界別にグルーピングして、業績、価値を数値化していきくのがいいと思います。

投資戦略

企業動向に加えて、ポジティブイメージな情報、ネガティブイメージな情報の量や今後の業績への影響を数値化していきくのがいいと思います。

営業戦略

上場企業であれば、中長期計画、短中期計画を Web で公開していると思います。
その計画には『今』と『未来』について書かれています。
至近で必要としている事については、ベンチマークと営業をします。
未来で必要としている事については、社内教育とマニュアル作成をします。




必要なスキル

Web スクレイピング

Web サイトから情報を収集することです。
各企業の Web サイトから情報を収集してきます。
このブログでも基礎的なことは記事にしてます。

高速テキスト処理

各企業の Web サイトから収集した情報を処理しやすい形でテキスト出力します。
情報量や企業数によっては処理時間が莫大になるので、それなりにアルゴリズムを考える必要があります。
このブログでも VBA で高速化のアルゴリズムを記事にしてます。

自然言語処理

係り受け解析を行い、自然言語から情報を数値化していきます。
自然言語処理自体がそもそも処理時間がかかるモノなので、保存しておいたテキストファイルから実行する事をオススメします。
今後、記事にしていきたいです。

報告書作成

報告書は人に読まれる訳ですから、無難にワードで作成しましょう。
手軽に普通に VBA でコーディングしましょう。
あんまり記事にしていくつもりは無いかも…




コメント

出来れば全部コーディングして自動化しておきたい…
頑張ります。

営業戦略はいい事書いた気がする。




以上

Visual Studio 2017 で C++ 再入門!ファイル読み込み!




こんにちは。
仕事の自動化にやりがいと達成感を感じるガッくんです。




この記事の目次




目的


今日は前回の記事で C++ でバイナリファイルを作ったので、バイナリファイルを読み込んでみようと思います。
載せる迄もないソースコードですが、忘れ防止の為にも掲載しておきます。




関数

バイナリ

面倒なのでざっくりと言って二進法です。
バイナリは二進法で出力されている電子データのことを指して使われていたりもします。

ソースコード
〜バイナリ出力〜

Visual Studio 2017 Community で C++ のコンソールアプリケーションのプロジェクトで作成しました。
その中のソースコードを丸ごと掲載します。

// FileDumper.cpp : Defines the entry point for the console application.
//

#include "stdafx.h"
#include 
#include 
#include 

using namespace std;

// Drag & Drop で動くプログラムです。
// argc : 引数の数が代入されます。
// argv : 引数の配列が代入されます。1 個目はこのプログラムのパスが入っているので、argc は絶対 1 以上になります。
int main(int argc, char * argv[])
{
    if (argc > 1) {
        for (int i = 1; i < argc; i++) {
            // 引数の表示
            cout << "argv[" << i << "] = " << argv[i] << "\n";

            ////////////////////////////////////////////////////////////////////////////////
            // バイナリ読み込み & ダンプ出力
            ////////////////////////////////////////////////////////////////////////////////

            //----------------------------- バイナリファイル -----------------------------//
             // 開くバイナリファイルのパス設定
            string BinaryFilePath = argv[i];

            //---------------------------- ダンプ出力ファイル ----------------------------//
            // ダンプ出力ファイル名用変数宣言
            string DumpFilePath;

            // ダンプファイル用拡張子
            string ext = ".dump";

            // ダンプ出力ファイルはバイナリファイルに拡張子を結合したファイル名とする
            DumpFilePath = BinaryFilePath + ext;

            // 確認用表示
            cout << DumpFilePath.c_str() << endl;

            // ダンプ出力するファイルの設定
            ofstream outputfile(DumpFilePath);

            //--------------------------------- 共通変数 ---------------------------------//
            // ルーラー
            char ruler[] = "Address  +0 +1 +2 +3 +4 +5 +6 +7 +8 +9 +A +B +C +D +E +F\n";

            // 出力回数カウント用変数
            int cnt = 0;

            // 行番号出力用
            long address = 0;

            // 読み込むための変数宣言
            unsigned char din;

            //-------------------------- バイナリファイルを開く --------------------------//
            // ios::in ; 読み込み専用
            // ios::binary ; バイナリ形式
            ifstream fin(BinaryFilePath, ios::in | ios::binary);

            // バイナリファイルが開けなかったときの処理
            if (!fin) {
                cout << "読み込むバイナリファイルが開けません\n";
                return 1;
            }

            // ルーラーの表示
            cout << ruler;

            // ルーラーの出力
            outputfile << ruler;

            while (!fin.eof()) {
                fin.read((char *)&din, sizeof(unsigned char));

                // アドレス表示
                if (cnt == 0) {
                    printf("x ", address);
                    outputfile << setw(8) << setfill('0') << hex << address << " ";
                }

                // 何を読み込んだのかわからないけど、とりあえず標準出力
                cnt += 1;
                if (cnt == 16) {
                    printf("x\n", din); // 16進数2桁表示 + 改行
                    outputfile << setw(2) << setfill('0') << hex << int(din) << endl;
                    cnt = 0;
                }
                else {
                    printf("x ", din); // 16進数2桁表示 + スペース
                   outputfile << setw(2) << setfill('0') << hex << int(din) << " ";
                }
                // アドレス更新
                address += 1;
            }

            cout << "\n\n";

            //------------------------- バイナリファイルを閉じる -------------------------//
            fin.close();

            //------------------------ ダンプ出力ファイルを閉じる ------------------------//
            outputfile.close();
        }
    }
    else {
        // 引数がなかった場合
        cout << "バイナリファイルを Drag & Drop してください。" << "\n";
    }

    system("pause");
    return 0;
}




コメント

コマンドプロンプトにダンプ出力され、ドロップしたバイナリファイルと同じディレクトリにダンプした内容がテキスト出力されます。




以上

Visual Studio 2017 で C++ 再入門!ファイル出力する!




こんにちは。
この記事を書いているときは仕事で急遽 C++ の出番になり、他の記事で VBA の高速化を考えてきたのにやっぱり、 C++ で書いていこうかなぁ…と思っている仕事の自動化にやりがいと達成感を感じるガッくんです。




この記事の目次




目的


今日は C++ です。バイナリでファイルを出力します。バイナリファイルを読み込むプログラムをササっと作った時に、テストデータが必要だったもので、作成したソースコードです。
このブログは別に VBS と VBA だけに特化して行くわけでは無く、色んなプログラム言語を使って自動化をして行くつもりなので、今回はその取っ掛かりとして C++ の記事を書きます。
載せる迄もないソースコードですが、忘れ防止の為にも掲載しておきます。




関数

バイナリ

面倒なのでざっくりと言って二進法です。
バイナリは二進法で出力されている電子データのことを指して使われていたりもします。

ソースコード
〜バイナリ出力〜

Visual Studio 2017 Community で C++ のコンソールアプリケーションのプロジェクトで作成しました。
その中のソースコードを丸ごと掲載します。

// BinaryWriter.cpp : Defines the entry point for the console application.
//

#include "stdafx.h"
#include 
#include 
#include 

using namespace std;

int main()
{
    ////////////////////////////////////////////////////////////////////////////////
    // バイナリ書き込み
    ////////////////////////////////////////////////////////////////////////////////
    
    // 書き込むためのファイルストリーム宣言
    ofstream fout;

    // 書き込むデータの用意
    char OutFilePath[] = "C:\\test1.bin";
    int num[] =  { 230, 1000, 31435, 543, 3, 365 };
    double d[] = { 63.85, 75.54864, 56.5456, 46.23 };
    char a[] = "abcdefghijklmnopqrstuvwxyz";

    // 書き込むデータの配列のサイズの取得
    int numLength = sizeof(num) / sizeof(num[0]);
    int dLength = sizeof(d) / sizeof(d[0]);
    int aLength = sizeof(a) / sizeof(a[0]);

    // ファイルを開く(もちろんファイルがなかったら新規作成します。)
    // ios::out ; 書き込み専用
    // ios::binary ; バイナリ出力
    fout.open(OutFilePath, ios::out | ios::binary);

    //  ファイルが開けなかったときの処理
    if (!fout) {
        cout << "バイナリを書き込むファイルが開けません\n";
        return 1;
    }

    // 書き込み
    // num[] の出力
    for (int i = 0; i < numLength; i++) {
        fout.write((char *)&num[i], sizeof(int));
    }

    // d[] の出力
    for (int i = 0; i < dLength; i++) {
        fout.write((char *)&d[i], sizeof(double));
    }

    // a[] の出力
    for (int i = 0; i < aLength; i++) {
        fout.write((char *)&a[i], sizeof(char));
    }

    // ファイルを閉じる
    fout.close();

    cout << "正常にバイナリファイルが作成されました。\n";
    return 0;
}




コメント

C ドライブ直下にバイナリファイルが出来るだけです。




以上

VBA による大量データから高速検索と抽出


こんにちは。
仕事の自動化にやりがいと達成感を感じるガッくんです。


[商品価格に関しましては、リンクが作成された時点と現時点で情報が変更されている場合がございます。]

菊正宗 日本酒の化粧水 高保湿(500mL)
価格:816円(税込、送料別) (2019/5/18時点)



この記事の目次




目的


ファイル出力の記事を書きたいのですが、ファイル出力するためのテキスト処理を作成したところ、とんでもなく処理に時間がかかり、ファイル出力の前に色々と高速化について取り組んでます。

この記事では大量データから検索を行う VBA を作成して、その実行時間を検証します。
なるべく高速で検索出来るようにバイナリサーチアルゴリズムなどを調べて作成しました。

この記事では下の①〜②の実行時間を調べました。
①自作VLOOKUP関数での検索
②自作VLOOKUP関数(改)での検索




関数

検索用データ

検索を行うために Excel でテストデータを作成しました。
作成したテストデータのキャプチャ画像を図1と図2に示します。

図1 検索される配列

図2 検索する配列

また、検索される配列(図1)の"No."は昇順で飛び飛びの値としています。
"data 1"、"data 2"は乱数で適当な値としています。

また、検索する配列(図2)の"No."は使用していないので、ただのナンバリングです。
"検索値"はデータ数に基づいて変更する必要があるため、図3に示す数式を入力しました。
"data 2"は Excel の VLOOKUP 関数です。 VBA のコードが返してきた値が正しいのかを確認するために使いました。

図3 検索値の数式

自作VLOOKUP関数

単純に For 〜 Next で配列を検索して、同一値が有ったら任意の列の値を返す関数です。

ソースコード
〜自作VLOOKUP関数〜


Sub 自作関数でVLOOKUP()
   
    ' 検索されるデータ数
    ' この設定を 10,000 ~ 1,000,000 まで変更した
    データ数 = ThisWorkbook.Sheets("検索用データ").Cells(3, 10).Value
   
    ' 検索するデータ数
    繰り返し数 = 500
   
    ' 開始時刻の記録
    開始時刻 = Time
   
    ' 検索される配列の取得
    With ThisWorkbook.Sheets("検索用データ")
       
        検索される配列 = .Range(.Cells(4, 2), .Cells(4 + データ数 - 1, 4))
       
    End With
   
    ' 検索する値の取得
    With ThisWorkbook.Sheets("検索用データ")
       
        検索する配列 = .Range(.Cells(4, 7), .Cells(4 + 繰り返し数 - 1, 7))
       
    End With
   
    getColumn = 3 ' 抽出する配列の列番号
   
    ' メモリ上の配列に対する VLOOKUP 実行
    For i = LBound(検索する配列) To UBound(検索する配列)
       
        ret = VLOOKUP4ARRAY2perfect(検索する配列(i, 1), 検索される配列, getColumn)
       
    Next i
   
    ' 終了時刻の記録
    終了時刻 = Time
   
    ' プログラムの実行時間を計算
    実行時間 = DateDiff("s", 開始時刻, 終了時刻)
   
    ' 実行時間をイミディエイトウィンドウに出力
    Debug.Print "データ数: " & データ数 & vbNewLine & _
                "Start: " & 開始時刻 & vbNewLine & _
                "End: " & 終了時刻 & vbNewLine & _
                "実行時間: " & 実行時間 & " sec" & vbNewLine
   
End Sub



'------------------------------------------------------------------------------
' 引数1:定数1
' 引数2:配列1(2次元配列)
' 引数3:定数2
' 動作:引数2の配列で引数1と同一値を検索して引数3の配列値を返す。
'------------------------------------------------------------------------------
Function VLOOKUP4ARRAY2perfect(ByVal SearchKey, ByRef ArrTarget, ByVal getColumn)
   
    ' そもそも検索する値が数値でないといけない関数なので、型変換
    If IsNumeric(SearchKey) And SearchKey <> "" Then
        SearchKey = Val(SearchKey)
    Else
        VLOOKUP4ARRAY2perfect = ""
    End If
   
    ' 配列の先頭列をスキャン
    For i = LBound(ArrTarget, 1) To UBound(ArrTarget, 1)
       
        ' 配列の先頭列が SearchKey と同一の場合は配列の getColumn を返す
        If Val(ArrTarget(i, LBound(ArrTarget, 2))) = SearchKey Then
           
            VLOOKUP4ARRAY2perfect = ArrTarget(i, getColumn)
            Exit For
           
        End If
       
        DoEvents
       
    Next i
   
End Function

ソースコード①の実行時間

検索に時間がかかり過ぎて、中断しました。何か手を加えないとソースコード①は使い物になりませんでした。

自作VLOOKUP関数(改)

『高速検索 アルゴリズム』でネット検索して、色々見て見たんですが『バイナリサーチ』というアルゴリズムを参考に改造しました。
大まかに言うと、検索する値が検索される配列のどこら辺にあるかを計算して、 For 〜 Next する範囲を小さくする処理を追加しました。
どこまで範囲を小さくするかの閾値として『上限行距離』という変数を作成しました。
この変数は配列のα行〜β行の範囲に検索する値があるとした時、α〜β行が何行あるかを計算し、上限行距離の行数より小さければ For 〜 Next で値を抽出するという具合に使っています。

ソースコード
〜自作VLOOKUP関数(改)〜


Sub 自作関数でVLOOKUP改()
   
    ' 検索されるデータ数
    ' この設定を 10,000 ~ 1,000,000 まで変更した
    データ数 = ThisWorkbook.Sheets("検索用データ").Cells(3, 10).Value
   
    ' 検索するデータ数
    繰り返し数 = 500
   
    ' 開始時刻の記録
    開始時刻 = Time
   
    ' 検索される配列の取得
    With ThisWorkbook.Sheets("検索用データ")
       
        検索される配列 = .Range(.Cells(4, 2), .Cells(4 + データ数 - 1, 4))
       
    End With
   
    ' 検索する値の取得
    With ThisWorkbook.Sheets("検索用データ")
       
        検索する配列 = .Range(.Cells(4, 7), .Cells(4 + 繰り返し数 - 1, 7))
       
    End With
   
    getColumn = 3 ' 抽出する配列の列番号
   
    ' メモリ上の配列に対する VLOOKUP 実行
    For i = LBound(検索する配列) To UBound(検索する配列)
       
        ret = FastVLOOKUP4ARRAY2perfect(検索する配列(i, 1), 検索される配列, getColumn)
       
    Next i
   
    ' 終了時刻の記録
    終了時刻 = Time
   
    ' プログラムの実行時間を計算
    実行時間 = DateDiff("s", 開始時刻, 終了時刻)
   
    ' 実行時間をイミディエイトウィンドウに出力
    Debug.Print "データ数: " & データ数 & vbNewLine & _
                "Start: " & 開始時刻 & vbNewLine & _
                "End: " & 終了時刻 & vbNewLine & _
                "実行時間: " & 実行時間 & " sec" & vbNewLine
   
End Sub



'------------------------------------------------------------------------------
' 引数1:定数1
' 引数2:配列1(2次元配列)
' 引数3:定数2
' 動作:引数2の配列で引数1と同一値を検索して引数3の配列値を返す。
'------------------------------------------------------------------------------
Function FastVLOOKUP4ARRAY2perfect(ByVal SearchKey, ByRef ArrTarget, ByVal getColumn)
   
    ' 配列の分布を調べる
    最小行 = LBound(ArrTarget, 1)
    最小値 = Val(ArrTarget(LBound(ArrTarget, 1), LBound(ArrTarget, 2)))
   
    中央行 = Val((UBound(ArrTarget, 1) + LBound(ArrTarget, 1)) / 2)
    中央値 = Val(ArrTarget(中央行, LBound(ArrTarget, 2)))
   
    最大行 = UBound(ArrTarget, 1)
    最大値 = Val(ArrTarget(UBound(ArrTarget, 1), LBound(ArrTarget, 2)))
   
    ' ループ回数の上限
    ' この設定を 5 ~ 5,000 まで変更した
    上限行距離 = ThisWorkbook.Sheets("検索用データ").Cells(3, 12).Value
   
    ' そもそも検索する値が数値でないといけない
    If IsNumeric(SearchKey) And SearchKey <> "" Then
        SearchKey = Val(SearchKey)
    Else
        FastVLOOKUP4ARRAY2perfect = ""
    End If
   
Area検索:
   
    If 中央値 <= SearchKey Then
        
        距離 = 最大行 - 中央行
        
        If 上限行距離 <= 距離 Then
           
            最小行 = 中央行
            最小値 = Val(ArrTarget(最小行, LBound(ArrTarget, 2)))
           
            最大行 = 最大行
            最大値 = Val(ArrTarget(最大行, LBound(ArrTarget, 2)))
           
            中央行 = Val((最大行 + 最小行) / 2)
            中央値 = Val(ArrTarget(中央行, LBound(ArrTarget, 2)))
           
            DoEvents
            GoTo Area検索:
           
        Else
           
            昇順 = SearchKey - 中央値
            降順 = 最大値 - SearchKey
           
            If 昇順 >= 降順 Then
                スタート = 最大行
                エンド = 中央行
                更新 = -1
            Else
                スタート = 中央行
                エンド = 最大行
                更新 = 1
            End If
           
        End If
       
    ElseIf 中央値 > SearchKey Then
        
        距離 = 中央行 - 最小行
        
        If 上限行距離 <= 距離 Then
           
            最小行 = 最小行
            最小値 = Val(ArrTarget(最小行, LBound(ArrTarget, 2)))
           
            最大行 = 中央行
            最大値 = Val(ArrTarget(最大行, LBound(ArrTarget, 2)))
           
            中央行 = Val((最大行 + 最小行) / 2)
            中央値 = Val(ArrTarget(中央行, LBound(ArrTarget, 2)))
           
            DoEvents
            GoTo Area検索:
           
        Else
           
            昇順 = SearchKey - 最小値
            降順 = 中央値 - SearchKey
           
            If 昇順 >= 降順 Then
                スタート = 中央行
                エンド = 最小行
                更新 = -1
            Else
                スタート = 最小行
                エンド = 中央行
                更新 = 1
            End If
           
        End If
       
    End If
   
    ' 配列の先頭列をスキャン
    For i = スタート To エンド Step 更新
       
        ' 配列の先頭列が SearchKey と同一の場合は配列の getColumn を返す
        If Val(ArrTarget(i, LBound(ArrTarget, 2))) = SearchKey Then
           
            FastVLOOKUP4ARRAY2perfect = ArrTarget(i, getColumn)
            Exit For
           
        End If
       
        DoEvents
       
    Next i
   
End Function

ソースコード②の実行時間

かなりループ回数の削減が出来たようで、かなりの実行時間短縮に成功しました。実行時間をまとめた表を図4に示します。
また、実行時間をまとめたグラフを図5に示します。

図4、図5より上限行距離が小さい方が実行時間も短い結果になりました。まぁ、当たり前ですが。

図4 自作VLOOKUP関数(改)の実行時間表

図5 自作VLOOKUP関数(改)の実行時間グラフ




コメント

検索スピードを上げることは出来ました。100万行の配列からの検索でも1秒以下で値を拾い出すことができました。
しかし、上の関数では文字列の検索が出来ないので、文字列の検索が出来るようにするのが課題です。




以上

VBA による大量データの高速ソート




こんにちは。
仕事の自動化にやりがいと達成感を感じるガッくんです。




この記事の目次




目的


ファイル出力の記事を書きたいのですが、ファイル出力するためのテキスト処理を作成したところ、とんでもなく処理に時間がかかり、ファイル出力の前に色々と高速化について取り組んでます。

この記事では既に定説のようになりつつあるソートの高速化を検証します。

結論としては Excel のソート機能を VBA から動作させるのが一番早いということになりました。
この記事では下の①〜④の実行時間を調べました。
①For 〜 Next の空回し速度
クイックソートによるソート
③ソート用データのコピー
④シート上でのソート




関数

For 〜 Next の空回し

そもそも For 〜 Next の速度を知らなかったので、確認のためにやってみました。

ソースコード
〜For 〜 Next の空回し〜


Sub For文の実行時間について()
   
    ' 開始時刻の記録
    開始時刻 = Time
   
    ' 繰り返し回数の設定
    ' この設定を 50,000 ~ 1,000,000 まで変更した
    データ数 = 50000
   
    ' カウンター
    cnt = 1
   
    ' 繰り返し処理
    For i = 1 To データ数
       
        ' 進捗出力
        If (i / データ数) * 100 > cnt Then
            Debug.Print Application.WorksheetFunction.RoundDown((i / データ数) * 100, 0) & " % 完了  Time: " & Time
            cnt = cnt + 1
        End If
       
        DoEvents
       
    Next i
   
    ' 終了時刻の記録
    終了時刻 = Time
   
    ' プログラムの実行時間を計算
    実行時間 = DateDiff("s", 開始時刻, 終了時刻)
   
    ' 実行時間をイミディエイトウィンドウに出力
    Debug.Print "Start: " & 開始時刻 & vbNewLine & "End: " & 終了時刻 & vbNewLine & "実行時間: " & 実行時間 & " sec"
   
End Sub

ソースコード①の実行時間

ただの空回しなのになかなか時間がかかりました。100万回の繰り返しは実用的とは言えない状況でした。
For 〜 Next の空回しにかかった時間の表とグラフを図1に示します。

図1 For 〜 Next 空回しの実行時間とグラフ

ソート用データ

今回、検証のために用意したデータを図2に示します。

図2 ソート用データ

クイックソート

有名なアルゴリズムです。
For 〜 Next の空回し時間から期待は薄いですが、やってみます。

ソースコード
クイックソート


'------------------------------------------------------------------------------
' 引数1:配列1(ソートする2次元配列)
' 引数2:定数1(ソート対象最小行)
' 引数3:定数2(ソート対象最大行)
' 引数4:定数3(配列1におけるソートキー列)
' 動作:引数1の配列で引数2から引数3までの行を引数4の列をキーにして並び変える。
'------------------------------------------------------------------------------
Sub クイックソート(ByRef data, Min, Max, key)
   
    Dim i As Double
    Dim j As Double
    Dim k As Double
   
    Dim 基準1 As Variant
    Dim 基準2 As Variant
   
    基準1 = CDbl(data(Int((Min + Max) / 2), key))
    i = Min
    j = Max
   
    Do
        Do While CDbl(data(i, key)) < 基準1
            i = i + 1
            DoEvents
        Loop
        
        Do While CDbl(data(j, key)) > 基準1
            j = j - 1
            DoEvents
        Loop
       
        If i >= j Then Exit Do
        For k = LBound(data, 2) To UBound(data, 2)
            基準2 = data(i, k)
            data(i, k) = data(j, k)
            data(j, k) = 基準2
        Next
        DoEvents
        i = i + 1
        j = j - 1
    Loop
   
    If (Min < i - 1) Then
        Call クイックソート(data, Min, i - 1, key)
    End If
   
    If (Max > j + 1) Then
        Call クイックソート(data, j + 1, Max, key)
    End If
   
End Sub

ソースコード②の実行時間

やはり100万回の繰り返しは無謀でした。
クイックソートにかかった時間の表とグラフを図3に示します。

図3 クイックソートの実行時間とグラフ

シート上でのソート

Excel のソート機能を VBA から動作させます。
実際にプログラムに組み込む事を考えると、ソート前のデータを別シートにコピーして、コピーデータをソートする事にします。
という事で、コピペのスピードから確認します。

ソースコード
〜ソート用データコピー〜


Sub ソート用データコピー()
    ' 繰り返し回数の設定
    ' この設定を 50,000 ~ 1,000,000 まで変更した
    データ数 = 1000000
   
    ' 開始時刻の記録
    開始時刻 = Time
   
    ' 実行時間をイミディエイトウィンドウに出力
    Debug.Print
   
    ' 並び変え用配列の取得
    With ThisWorkbook.Sheets("ソート用データ")
       
        並び変え用配列 = .Range(.Cells(4, 2), .Cells(4 + データ数 - 1, 4))
       
    End With
   
    ' 並び変え用配列の出力
    With ThisWorkbook.Sheets("シートソート")
       
        .Range(.Cells(4, 2), .Cells(4 + UBound(並び変え用配列, 1) - 1, 2 + UBound(並び変え用配列, 2) - 1)) = 並び変え用配列
       
    End With
   
    ' 終了時刻の記録
    終了時刻 = Time
   
    ' プログラムの実行時間を計算
    実行時間 = DateDiff("s", 開始時刻, 終了時刻)
   
    ' 実行時間をイミディエイトウィンドウに出力
    Debug.Print "データ数: " & データ数 & vbNewLine & _
                "Start: " & 開始時刻 & vbNewLine & _
                "End: " & 終了時刻 & vbNewLine & _
                "実行時間: " & 実行時間 & " sec" & vbNewLine
   
End Sub

ソースコード③の実行時間

コピーの処理だけなので、100万行のデータコピー処理にかかった時間は微妙です。
50万行のデータコピーまでならなんとか速いと言えるかどうかです。

図4 ソート用データコピーの実行時間とグラフ

ソースコード
〜シート上でのソート〜


Sub シートソート()
   
    ' 繰り返し回数の設定
    ' この設定を 50,000 ~ 1,000,000 まで変更した
    データ数 = 1000000
   
    ' 並び変えの Key 列の設定
    ' この設定を 1 ~ 3 まで変更した
    Key列 = 1
   
    ' 開始時刻の記録
    開始時刻 = Time
   
    ' 並び変え用配列の取得
    With ThisWorkbook.Sheets("ソート用データ")
       
        並び変え用配列 = .Range(.Cells(4, 2), .Cells(4 + データ数 - 1, 4))
       
    End With
   
    ' コピー出力先シートの初期化
    With ThisWorkbook.Sheets("シートソート")
       
        .Range(.Cells(4, 2), .Cells(4 + UBound(並び変え用配列, 1) - 1, 2 + UBound(並び変え用配列, 2) - 1)).ClearContents
       
    End With
   
    ' 並び変え用配列の出力
    With ThisWorkbook.Sheets("シートソート")
       
        .Range(.Cells(4, 2), .Cells(4 + UBound(並び変え用配列, 1) - 1, 2 + UBound(並び変え用配列, 2) - 1)) = 並び変え用配列
       
        Set 並び変え範囲 = .Range(.Cells(4, 2), .Cells(4 + UBound(並び変え用配列, 1) - 1, 2 + UBound(並び変え用配列, 2) - 1))
       
        Set 並び変えKey = .Range(.Cells(4, 2 + Key列 - 1), .Cells(4 + UBound(並び変え用配列, 1) - 1, 2 + Key列 - 1))
       
    End With
   
    ' ソートの条件設定
    With ThisWorkbook.Sheets("シートソート")
       
        .Sort.SortFields.Clear
       
        .Sort.SortFields.Add key:=並び変えKey _
            , SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
       
    End With
   
    ' ソートの実行
    With ActiveWorkbook.Worksheets("シートソート").Sort
       
        .SetRange 並び変え範囲
        .Header = xlNo
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
       
    End With
   
    ' 終了時刻の記録
    終了時刻 = Time
   
    ' プログラムの実行時間を計算
    実行時間 = DateDiff("s", 開始時刻, 終了時刻)
   
    ' 実行時間をイミディエイトウィンドウに出力
    Debug.Print "データ数: " & データ数 & vbNewLine & _
                "Start: " & 開始時刻 & vbNewLine & _
                "End: " & 終了時刻 & vbNewLine & _
                "実行時間: " & 実行時間 & " sec" & vbNewLine
   
End Sub

ソースコード④の実行時間

事前にクイックソートでのソートをやっていたのですっごく速く感じましたが、微妙な時間は必要なようです。
ソート用データには Double 型の値を1列目に入れているので1列目に key にソートするとやはり整数型の値を key にするよりは時間がかかります。

図5 シート上でのソートの実行時間とグラフ

最後に

クイックソートとシート上でのソートはやはりシート上でのソートの方が実行時間は短いようです。
図6に結果をまとめ表とグラフを示しますが、一目瞭然でシート上でのソートが速いです。

図6 シート上でのソートの実行時間とグラフ




コメント

シート上でのソートは Excel が 1,048,576 行までしかないので、 1,048,576 行を超える配列は扱えないのが難点ですね。




以上

VBA による高速テキスト出力


こんにちは。
仕事の自動化にやりがいと達成感を感じるガッくんです。




この記事の目次




目的


VBA では大量なデータを扱う事は出来ないと思われています。まぁ、実際、C++ と比べたら、プログラム言語であるという事ですら『?』が付きそうなほどですが。

そんな VBA ですが、サクッと使うには良いんです!
テキストファイルのダミーデータなどを作るのにはまさに良いんです!手軽さが!
ですが、大容量のダミーデータは現実的な時間で作成出来るのか、どの程度の容量のデータまでなら作れるのか……

そこで、テキストファイル出力の実行時間を測定します。
出力データは 50 万行× 2 列の半角スペース区切りのデータとします。




関数

ファイル出力方法①

出力データの 50 万行× 2 列の半角スペース区切りのデータは 1 列目は行数と同じ番号、 2 列目は乱数で 1 列目と 2 列目は半角スペースで区切られているデータ構造にします。

ソースコード
〜テキストファイル出力〜

50 万行× 2 列のデータを For 〜 Next で作成して、ファイルシステムオブジェクトでテキストファイルに出力するプログラムの実行時間を測定してみます。

Sub テキスト出力の実行時間測定1()
   
    ' プログラムの開始時刻を記録
    開始時刻 = Time
   
    ' a 以上 b 以下の乱数作成する設定
    a = 100
    b = 350
   
    ' 50 万
    データ数 = 500000
   
    ' カウンター
    cnt = 1
   
    ' 出力するデータ格納用変数
    データ = ""
   
    ' 50 万回繰り返す
    For i = 1 To データ数
       
        ' データ変数が空なら
        If データ = "" Then
            
            ' 1列目のデータ
            データ = i
           
            ' 2列目のデータ
            乱数 = Rnd() * (b - a + 1) + a
           
            データ = データ & " " & 乱数
           
        ' データ変数に1回でも代入済みなら
        Else
           
            ' 1列目のデータ
            データ = データ & vbNewLine & i
           
            ' 2列目のデータ
            乱数 = Rnd() * (b - a + 1) + a
           
            データ = データ & " " & 乱数
           
        End If
       
        ' 進捗をイミディエイトウィンドウに出力
        If (i / データ数) * 100 > cnt Then
            Debug.Print Application.WorksheetFunction.RoundDown((i / データ数) * 100, 0) & " % 完了  Time: " & Time
            cnt = cnt + 1
        End If
       
        DoEvents
       
    Next i
   
    '////////////////////////////////////////////////////////////////////////////////////////////////////////
    ' 出力
    '////////////////////////////////////////////////////////////////////////////////////////////////////////
    Call データ出力("50万行×2列", データ)
    '////////////////////////////////////////////////////////////////////////////////////////////////////////
   
    ' プログラムの終了時刻を記録
    終了時刻 = Time
   
    ' プログラムの実行時間を計算
    実行時間 = DateDiff("s", 開始時刻, 終了時刻)
   
    ' 実行時間をイミディエイトウィンドウに出力
    Debug.Print "Start: " & 開始時刻 & vbNewLine & "End: " & 終了時刻 & vbNewLine & "実行時間: " & 実行時間 & " sec"
   
    ' プログラムの終了アナウンス
    MsgBox "テキスト出力完了"
   
End Sub



'------------------------------------------------------------------------------
' 引数1:ファイル名(拡張子無)
' 引数2:出力文字列
' 動作:このExcelと同じ場所に引数2の内容を引数1で指定したファイル名で保存する。
'------------------------------------------------------------------------------
Sub データ出力(ByVal データ名, ByVal 出力内容文字列)
   
    '変数を定義します
    Dim FSO As Object
   
    'オブジェクトを作ります
    Set FSO = CreateObject("Scripting.FileSystemObject")
   
    With FSO.CreateTextFile(ThisWorkbook.Path & "\" & データ名 & ".txt")
        .writeline 出力内容文字列
        .Close
    End With
   
    ' メモリの明示的開放
    Set FSO = Nothing
   
End Sub

ソースコード①の実行時間

ソースコード①を実行しましたが、 10 分以上実行し続けて、 30 % 程度しかデータを作成出来ませんでした。

『このままでは何分かかるか分からない』と思い、実行を中止しました。
実行開始から中止するまでのデータ作成率とその経過時間の一覧表を表1に示します。
また、図1にデータ作成率とその経過時間のグラフを示します。

表1 データ作成率とその経過時間


図1 データ作成率とその経過時間

ファイル出力方法②

ファイル出力方法①では For 〜 Next のループ速度がループ回数を重ねるにつれてどんどん遅くなっていきました。

For 〜 Next のループ速度を高速かつ高速状態を維持するには、ループ回数が数回行われたら、ループ速度が遅くなる前にテキストファイル出力して、常にループ速度が速い状態になるようにすれば良いと思いました。

そこで、出力テキストを格納する変数が『ある byte 数』に達したら、テキストファイル出力する処理を追加しました。
出力テキストを格納する変数の容量は 100 byte 〜 1700 byte で 100 byte ずつ変化させました。

ソースコード
〜テキストファイル出力〜

50 万行× 2 列のデータを For 〜 Next で作成して、データがある byte 数に達したら、テキストファイルに出力するプログラムの実行時間を測定してみます。

Sub テキスト出力の実行時間計測2()
   
    ' プログラムの開始時刻を記録
    開始時刻 = Time
   
    ' a 以上 b 以下の乱数作成する設定
    a = 100
    b = 350
   
    ' 50 万
    データ数 = 500000
   
    ' カウンター
    cnt = 1
   
    ' 1回に出力するバイト数を設定する
    ' この変数を 100 ~ 1700 まで変更した
    出力単位 = 1700
    出力回数 = 0
   
    ' 出力するデータ格納用変数
    データ = ""
   
    ' 50 万回繰り返す
    For i = 1 To データ数
       
        ' データ変数が空なら
        If データ = "" Then
           
            ' 1列目のデータ
            データ = i
           
            ' 2列目のデータ
            乱数 = Rnd() * (b - a + 1) + a
           
            データ = データ & " " & 乱数
           
        ' データ変数に1回でも代入済みなら
        Else
           
            ' 1列目のデータ
            データ = データ & vbNewLine & i
           
            ' 2列目のデータ
            乱数 = Rnd() * (b - a + 1) + a
           
            データ = データ & " " & 乱数
            
        End If
       
        ' 進捗をイミディエイトウィンドウに出力
        If (i / データ数) * 100 > cnt Then
            Debug.Print Application.WorksheetFunction.RoundDown((i / データ数) * 100, 0) & " % 完了  Time: " & Time
            cnt = cnt + 1
        End If
       
        '////////////////////////////////////////////////////////////////////////////////////////////////////////
        ' 出力
        '////////////////////////////////////////////////////////////////////////////////////////////////////////
        If 出力単位 <= LenB(データ) Then
           
            If 出力回数 = 0 Then
                Call データ出力("50万行×2列", データ)
                データ = ""
                出力回数 = 出力回数 + 1
            Else
                Call データ追記("50万行×2列", データ)
                データ = ""
               出力回数 = 出力回数 + 1
            End If
           
        End If
        '////////////////////////////////////////////////////////////////////////////////////////////////////////
       
        DoEvents
       
    Next i
   
    ' プログラムの終了時刻を記録
    終了時刻 = Time
   
    ' プログラムの実行時間を計算
    実行時間 = DateDiff("s", 開始時刻, 終了時刻)
   
    ' 実行時間をイミディエイトウィンドウに出力
    Debug.Print "Start: " & 開始時刻 & vbNewLine & "End: " & 終了時刻 & vbNewLine & "実行時間: " & 実行時間 & " sec"
   
    ' プログラムの終了アナウンス
    MsgBox "テキスト出力完了"
   
End Sub



Sub データ出力(ByVal データ名, ByVal 出力内容文字列)
   
    '変数を定義します
    Dim FSO As Object
   
    'オブジェクトを作ります
    Set FSO = CreateObject("Scripting.FileSystemObject")
   
    With FSO.CreateTextFile(ThisWorkbook.Path & "\" & データ名 & ".txt")
        .writeline 出力内容文字列
        .Close
    End With
   
    ' メモリの明示的開放
    Set FSO = Nothing
   
End Sub



Sub データ追記(ByVal データ名, ByVal 出力内容文字列)
   
    fnsave = ThisWorkbook.Path & "\" & データ名 & ".txt"
   
    numff = FreeFile
   
    Open fnsave For Append As #numff
   
    Print #numff, 出力内容文字列
   
    Close #numff
   
End Sub

ソースコード②の実行時間

ソースコード②を実行したら、とても短い実行時間でデータ作成が完了しました。

50 万行× 2 列の半角スペース区切りのデータが最短で『 14 秒』でテキストファイル出力が完了しました。

1度にテキストファイルへ出力するデータ容量とその出力実行時間の一覧表及びグラフを図2に示します。

図2 データ容量とその出力実行時間間




コメント

14 秒実用的と思うか思わないかは個人差があると思います。
私は 50 万行× 2 列のテキストファイルが 14 秒で出来るのであれば実用的と思います。




以上

VBA によるテキスト処理




こんにちは。
仕事の自動化にやりがいと達成感を感じるガッくんです。




この記事の目次




目的


VBAを始めようとして、とりあえず『VBA』でインターネット検索をすると、『集計作業』、『報告書の作成作業』から始めると良いですよ!と書いてあるWebサイトが多々ありました。(筆者調べ)

そこで、報告書を作成するVBAは既にあるのですが、ソースコードもエクセルも整理されていないので、ここでちょっと整理して1つにまとめてみようと思います。

まとめ方としては、こんな感じでしょうかね。
①ファイル入力
②テキスト処理
③ファイル出力

この記事は、テキスト処理!!




関数

テキスト読み込み

どんな集計作業も報告書作成も元になるファイルがあるわけで、そのファイルを読み込まないと始まりません。

ソースコード
〜テキスト読み込み〜

先ずはファイルパスからテキストを読み込みます。

ファイル入力のインターフェースは下の図1の様なインターフェースを想定しています。

図1 ファイル入力インターフェース


'Public Const ShName = "ファイル入力"
'Public Const fld行 = 8
'Public Const fil行 = 11
'Public Const Name列 = 3
'Public Const Path列 = 9

Public Const ShName1 = "メモリ"
Public Const txt行 = 1
Public Const txt列 = 1

Sub ファイルパスリボルブ()
    
    i = fil行
    With ThisWorkbook.Worksheets(ShName)
        
        fPath = .Calls(i, Path列).Value
        While fPath <> ""
            
            Call テキスト読込(fPath)
            
            ' ここに『テキスト処理関数』を追加する
            '************************
            
            
            
            '************************
            
            i = i + 1
            fPath = .Calls(i, Path列).Value
            
        Wend
        
    End With
    
End Sub

Sub テキスト読込(ByVal fPath)
    
    Dim n As Integer
    Dim i As Integer
    Dim txtLine As String
    Dim FSO As Object
    
    Set FSO = CreateObject("Scripting.FileSystemObject")
    
    If Not FSO.FileExists(fPath) Then
    
        MsgBox "ファイルが存在しません"
        Exit Sub
        
    End If
    
    i = txt行
    
    n = FreeFile
    Open fPath For Input As #n
    
    Do While Not EOF(n)
        Line Input #n, txtLine
        ThisWorkbook.Worksheets(ShName1).Cells(i, txt列).Value = txtLine
        i = i + 1
    Loop
    
    Close #n
    
    Set FSO = Nothing
    
End Sub

テキスト処理

上のソースコード①で Excel にテキストを読み込みました。
ですが、読み込んだだけでまだ何もしてません。
今、テキストを自然言語だとします。つまり、日本語の文章が書かれているという事です。
かなり Microsoft Word の機能が使えるので、ちょっと処理してみます。

ソースコード
〜Word出力〜

Microsoft Word の機能を使うために Word をExcel VBA から起動して、テキストを Word に出力してみます。

Function Excel2Word()
    
    Set WdApp = CreateObject("Word.Application")
    WdApp.Visible = True
    WdApp.documents.Add
    
    i = txt行
    
    txtLine = ThisWorkbook.Worksheets(ShName1).Cells(i, txt列).Value
    While txtLine <> ""
        WdApp.Selection.typetext Text:=txtLine
        i = i + 1
        txtLine = ThisWorkbook.Worksheets(ShName1).Cells(i, txt列).Value
    Wend
    
    Set Excel2Word = WdApp
    
    Set WdApp = Nothing
    
End Function

ソースコード
〜文カウント〜

Microsoft Word に出力した文章がどれだけの文で構成されているかをカウントしてみます。

Function 文カウント(ByVal WdApp)
    
    Set Doc = WdApp.ActiveDocument
    Set Rng = Doc.Paragraphs(1).Range
    
    i = 0
    
    For Each stc In Rng.Sentences
        
        i = i + 1
        
    Next
    
    文カウント = i
    
End Function

ソースコード
〜単語カウント〜

今度は Microsoft Word に出力した文章がどれだけの単語で構成されているかをカウントしてみます。
ただし、このコードだと文章を構成する単語数をカウントするので、単語の重複は無視した単語数になります。

Function 単語カウント(ByVal WdApp)
    
    Set Doc = WdApp.ActiveDocument
    Set Rng = Doc.Paragraphs(1).Range
    
    i = 0
    
    For Each wrd In Rng.Words
        
        i = i + 1
        
    Next
    
    単語カウント = i
    
End Function

使い方

ソースコード①で書いた『ファイルパスリボルブ』に記載しておいた "ここに『テキスト処理関数』を追加する" という箇所にテキスト処理関数を記載します。

Sub ファイルパスリボルブ()
    
    i = fil行
    With ThisWorkbook.Worksheets(ShName)
        
        fPath = .Calls(i, Path列).Value
        While fPath <> ""
            
            Call テキスト読込(fPath)
            
            ' ここに『テキスト処理関数』を追加する
            '************************
            Set WdApp = Excel2Word()
            文数 = 文カウント(WdApp)
            単語数 = 単語カウント(WdApp)
            '************************
            
            i = i + 1
            fPath = .Calls(i, Path列).Value
            
        Wend
        
    End With
    
End Sub




コメント

テキスト出力処理が未実装なので、このままではテキスト処理の結果が確認出来ない状態です。
早くファイル出力の内容をまとめます。




以上