【VBA】特定の範囲内の任意の整数をインクリメント、デクリメントして次の値を求める
条件
- 任意の3つの整数において、以下の条件を満たす事(負の値があっても可)
- 最小値 <= 現在値 <= 最大値
- 範囲の最大値をインクリメントした場合、範囲の最小値を返す事。
- 範囲の最小値をデクリメントした場合、範囲の最大値を返す事。
求める式
インクリメント、デクリメントというからには、普通に考えれば増減値は1なので、以下のようになる。
要素数 = 最大値 - 最小値 + 1 'インクリメントする場合 次の値 = ( ( 現在値 + 1 - 最小値 ) Mod 要素数 ) + 最小値 'デクリメントする場合 次の値 = ( ( 現在値 + ( 要素数 - 1 ) - 最小値 ) Mod 要素数 ) + 最小値
補足
インクリメントの場合
現在値に1を加算し、要素数の剰余を利用する。
範囲の最小値が0でない場合、最小値を0に補正して剰余を求めた後、補正した分を戻す。
デクリメントの場合
インクリメントでは、要素数に1を加算したが、デクリメントの場合は、
(要素数 - 1 )を加算し、同様に計算する。
増減値が2以上の場合、前述の式の1の部分を変えれば良い。
要素数 = 最大値 - 最小値 + 1 'インクリメントする場合 次の値 = ( ( 現在値 + 加算する値 - 最小値 ) Mod 要素数 ) + 最小値 'デクリメントする場合 次の値 = ( ( 現在値 + ( 要素数 - 減算する値 ) - 最小値 ) Mod 要素数 ) + 最小値
ただし、以下の条件を満たす必要がある。
加算する値 >= 0
減算する値 >= 0 かつ 減算する値 <= 要素数
コード
Private Const ERROR_INVALID_PARAMETER As Long = 87 Public Function incrementBetweenNM(ByVal lCurrentValue As Long, _ ByVal lMinValue As Long, _ ByVal lMaxValue As Long, _ Optional ByVal lOffsetValue As Long = 1) As Long Dim lElements As Long If lMinValue > lMaxValue Then Err.Raise ERROR_INVALID_PARAMETER ElseIf lMaxValue < lCurrentValue Then Err.Raise ERROR_INVALID_PARAMETER ElseIf lMinValue > lCurrentValue Then Err.Raise ERROR_INVALID_PARAMETER End If If lOffsetValue < 0 Then Err.Raise ERROR_INVALID_PARAMETER ElseIf lOffsetValue > lMaxValue - lMinValue + 1 Then Err.Raise ERROR_INVALID_PARAMETER End If lElements = lMaxValue - lMinValue + 1 incrementBetweenNM = ((lCurrentValue + lOffsetValue - lMinValue) Mod lElements) + lMinValue End Function Public Function decrementBetweenNM(ByVal lCurrentValue As Long, _ ByVal lMinValue As Long, _ ByVal lMaxValue As Long, _ Optional ByVal lOffsetValue As Long = 1) As Long Dim lElements As Long If lMinValue > lMaxValue Then Err.Raise ERROR_INVALID_PARAMETER ElseIf lMaxValue < lCurrentValue Then Err.Raise ERROR_INVALID_PARAMETER ElseIf lMinValue > lCurrentValue Then Err.Raise ERROR_INVALID_PARAMETER End If If lOffsetValue < 0 Then Err.Raise ERROR_INVALID_PARAMETER ElseIf lOffsetValue > lMaxValue - lMinValue + 1 Then Err.Raise ERROR_INVALID_PARAMETER End If lElements = lMaxValue - lMinValue + 1 decrementBetweenNM = ((lCurrentValue + (lElements - lOffsetValue) - lMinValue) Mod lElements) + lMinValue End Function
実行例
テストコード
Public Sub getNext() Dim l As Long Dim u As Long Dim i As Long l = -3 u = 2 Debug.Print "最小値:" & l Debug.Print "最大値:" & u Debug.Print "" Debug.Print "現在値", "次の値", "前の値" For i = l To u Debug.Print i, incrementBetweenNM(i, l, u), decrementBetweenNM(i, l, u) Next End Sub
実行結果
call getNext 最小値:-3 最大値:2 現在値 次の値 前の値 -3 -2 2 -2 -1 -3 -1 0 -2 0 1 -1 1 2 0 2 -3 1
おまけのテスト その1
call getNext 最小値:1 最大値:1 現在値 次の値 前の値 1 1 1
最大値 = 最小値 だと、次の値も前の値も、みんな同じ・・・
あたりまえか。
おまけのテスト その2
Debug.Print i, incrementBetweenNM(i, l, u, 2), decrementBetweenNM(i, l, u, 3)
として、加算、減算する値を変えてみると
call getNext 最小値:-3 最大値:2 現在値 次の値 前の値 -3 -1 0 -2 0 1 -1 1 2 0 2 -3 1 -3 -2 2 -2 -1
【VBA】ADOを使ったテキストファイル(CSV)の読み込みについて調べてみた。ついでに、Line Input と速度を比べてみた。
タイトルに「比べてみた」と書いてあるけど、ADOでの処理や設定についてがメインだったりするので、結果だけ知りたい場合は、ずっと下の結果へ・・・
処理の流れ
- 事前準備
- Schema.ini ファイルの作成
- Connection オブジェクトの生成
- プロバイダの指定
- 処理対象ファイルのあるフォルダの指定
- プロパティの指定
- Open
- Recordset オブジェクトの生成
- Cursorの指定
- 排他処理(Lock)の指定
- SQLの指定
- Open
- データの取得
- データ読み込み
- 後処理
- Recordset オブジェクト、Connection オブジェクトを閉じて、開放
ADO
Schema.ini ファイル (テキスト ファイル ドライバー)
Schema.ini ファイルとは
Scema.ini というテーブル情報の設定ファイルを併用することで、テキストファイルの定義情報を指定し、ADOでその定義情報に従った形で読み込むとが可能となる。
Schema.ini については、以下参照。
docs.microsoft.com
Schema.ini の設定については、以下参照。
docs.microsoft.com
INIファイルの構成、書き方
INIファイルは、
- セクション
- キー
- 値
から構成され、以下のように構成されている。
[セクション1] キー11=値11 キー12=値12 キー13=値13 ;コメント(必要であれば) ・ ・ ・ [セクション2] キー21=値21 キー22=値22 キー23=値23 ・ ・ ・
Schema.ini では、
セクション | ファイル名 |
---|---|
キー | 設定項目名 |
値 | 設定項目の設定値 |
を書く。
設定項目
キーと値については、以下のような項目を設定することが出来る。
項目 | キー | 値 | 備考 |
---|---|---|---|
文字セット | CharacterSet | 932 | Shift-JIS |
65001 | UTF-8 | ||
ファイル書式 | Format | CSVDelimited | CSV |
TabDelimited | TSV(Tab区切り) | ||
Delimited(custom character) | 任意の文字での区切り | ||
FixedLength | 固定長 | ||
ヘッダ行の有無 | ColNameHeader | True | 先頭行をフィールド名として扱う |
False | 先頭行をデータとして扱う | ||
フィールドのデータ型を決定するためスキャンするレコード数 | MaxScanRows | 0 | 全レコードをスキャンする |
n | 先頭からnレコード目までに格納されているレコードをスキャン | ||
フィールド定義 | Coln | フィールド名 | |
データ型 | 下表参照 | ||
長さ | 固定長の場合 Width nn |
Coln=フィールド名 データ型 [Width 長さ]
n:列番号(Col1、Col2・・・)
データ型
以下の型を指定できます。
種別 | 型 | 備考 |
---|---|---|
Microsoft Jet のデータ型 | Bit | |
Byte | ||
Short | ||
Long | ||
Currency | ||
Single | ||
Double | ||
DateTime | ||
Text | ||
Memo | ||
ODBC のデータ型 | Char | Text |
Float | Double | |
Integer | Long Integer | |
LongChar | Blob | |
Date |
MaxScanRowsについて
あくまでもフィールドのデータ型を決定するためにスキャンするレコード数であって、レコードセットに取得するレコード数の制限ではないようです。
デフォルト値は、25だそうです。
dobon.net
記入例
[CSV100000.csv] CharacterSet=932 Format=CSVDelimited ColNameHeader=True Col1=F1 Text Col2=F2 Text Col3=F3 Text Col4=F4 Text Col5=F5 Text Col6=F6 Text Col7=F7 Text Col8=F8 Text Col9=F9 Text Col10=F10 Text [CSV1000000_UTF8.csv] CharacterSet=65001 Format=CSVDelimited ColNameHeader=True Col1=F1 Text Col2=F2 Text Col3=F3 Text Col4=F4 Text Col5=F5 Text Col6=F6 Text Col7=F7 Text Col8=F8 Text Col9=F9 Text Col10=F10 Text [Sample1.csv] CharacterSet=932 Format=CSVDelimited ColNameHeader=True Col1=F1 Short Col2=F2 Long Col3=F3 Text [Sample2.ssv] CharacterSet=932 ;スペース区切り "("と")"の間に、半角スペースがある Format=Delimited( ) ColNameHeader=False Col1=ID Short Col2=品名 Text Width 20 Col3=金額 Integer
余談ですが、スペース区切りのフォーマットは、SSV と言われることもあるそうです。
TSVは知っていたけど、SSVとかDSVとかは知らなかった。
類似したフォーマットとして、タブで区切られた tab-separated values (TSV)や、欧文間隔 (いわゆる半角スペース) で区切られた space-separated values (SSV) などがあり、これらをまとめて character-separated values (CSV)、delimiter-separated values (DSV) とも呼ばれることも多い。
Comma-Separated Values - Wikipedia
Connection オブジェクト
Connection オブジェクトについては、以下参照。
docs.microsoft.com
ConnectionString
対象ファイルに接続するための文字列を設定する必要があります。
以下の項目を設定します。
項目 | 値 | 備考 |
---|---|---|
Provider | Microsoft.ACE.OLEDB.12.0 Microsoft.Jet.OLEDB.4.0 |
Office 2007以降は、ACE それより前は、Jet |
Data Source | 対象ファイルのあるフォルダパス | ファイルパスではない |
Extended Properties | Text | データベースの種類が、テキストファイル |
HDR=Yes | 1行目をヘッダとして扱う場合 Yesを指定する 1行目からデータの場合は、No を指定する |
|
FMT=Delimited | CSVファイルの場合は、Delimitedを指定 |
各値の間には、";" を挟む。
Extended Properties の値は、「"」で括る。
記入例
Provider=Microsoft.ACE.OLEDB.12.0;Data Source=C:\Datas\;Extended Properties="Text;HDR=Yes;FMT=Delimited"
ConnectionString の HDR と Schema.ini の ColNameHeader
どちらも先頭行に対する扱いの指定ですが、双方の指定が異なった場合、Schema.ini の設定が優先されるようです。
結果としては、schema.iniファイルにフィールド定義情報がある場合は、そちらが優先される。
https://antonsan.net/vt/excel-db/heading-4/page-046
HDR=NO の設定がある場合、先頭行もデータとして取り込まれる。
Command オブジェクト
Command オブジェクトについては、以下を参照。
docs.microsoft.com
以下の項目を設定します。
プロパティ | 設定する値 | 備考 |
---|---|---|
ActiveConnection | Connection オブジェクト | |
CommandType | adCmdText | 引数をコマンド文字列として評価 |
CommandText | データを取得するためのSQL | テーブル名部分をファイル名とし、 [ ] で括る ファイル名と[ ] の間にスペースを含めない 例:SELECT * FROM [Sample.csv] |
SQL
ファイルから読み込むデータの指定を行う。
無条件に、全データを読み込む場合
SELECT * FROM [ファイル名]
特定のフィールドのみを指定して読み込む場合
SELECT フィールド名1,フィールド名2,・・・ FROM [ファイル名]
フィールド名nは、CSVファイルのヘッダ行に記載されている物を指定する。
HDR=No; を指定して読み込んだ場合には、ヘッダ行がないので、その場合には、
F1、F2 のように "F" + 何列目のデータかの番号 を指定する。
指定する順番は、ファイルの列の順番と一致していなくても構わない。(後ろの列を先に指定しても良い)
SELECT F1,F3 FROM [ファイル名] SELECT F5,F2 FROM [ファイル名]
SQLでは、いろいろな事が出来るので、興味がある方は、以下のようなキーワードを例にして調べてみて下さい。
抽出条件の指定:WHERE
並べ替え:ORDER BY
集計:GROUP BY
複数ファイルの結合:JOIN
サブクエリー
ワイルドカード
UNION
カーソル
カーソルについては、以下を参照。
docs.microsoft.com
CursorLocation
クライアント側カーソルの明確な利点の 1 つは、反応が速いことです。結果セットがクライアント コンピューターにダウンロードされた後は、非常に迅速に行を参照できます。
カーソル位置の重要性 | Microsoft Docs
ファイルサイズが大きいCSVファイルの場合、上記のダウンロード相当部分に時間がかかり、結果的にサーバー側カーソルの方が速い場合もあります。
実行環境に応じたカーソル位置を選択して下さい。
選択肢は以下の通りです。
CursorLocationEnum
定数 | 値 | 備考 |
---|---|---|
adUseServer | 2 | サーバー側 |
adUseClient | 3 | クライアント側 |
CursorType
カーソルの種類については、以下を参照。
docs.microsoft.com
選択肢は以下の通りです。
CursorTypeEnum
定数 | 値 | 備考 |
---|---|---|
adOpenForwardOnly | 0 | 前方スクロールタイプ 既定値 |
adOpenKeyset | 1 | キーセットカーソル |
adOpenDynamic | 2 | 動的カーソル |
adOpenStatic | 3 | 静的カーソル |
通常の読み込み作業(先頭から最後まで1回だけ読み込む)の場合には、adOpenForwardOnly で問題ないと思います。
Recordset オブジェクト
Recordset オブジェクトについては、以下参照。
docs.microsoft.com
カーソル情報(前述)及びレコードに適用されるロックの種類を設定します。
- CursorLocation
- CursorType
- LockType
LockType プロパティ
LockType プロパティについては、以下参照。
docs.microsoft.com
LockTypeEnum
定数 | 値 | 備考 |
---|---|---|
adLockReadOnly | 1 | 読み取り専用 既定値 |
adLockPessimistic | 2 | レコードごとの排他的ロック |
adLockOptimistic | 3 | レコードごとの共有的ロック |
adLockBatchOptimistic | 4 | 共有的バッチ更新 |
ローカルファイルの読み込み作業の場合には、adLockReadOnly で問題ないと思います。
RecordCount
RecordsetをOpenした後に、RecordCountプロパティにより、読み込んだレコードの件数を取得できる場合があります。
CursorLocation プロパティとCursorType プロパティの組み合わせにより、以下のようになります。
CursorLocation プロパティ | CursorType プロパティ | RecordCount 値 |
---|---|---|
adUseServer | adOpenForwardOnly | -1 |
adOpenKeyset | レコード数 | |
adOpenDynamic | -1 | |
adOpenStatic | レコード数 | adUseClient | adOpenForwardOnly | レコード数 |
adOpenKeyset | ||
adOpenDynamic | ||
adOpenStatic |
ソース
以下のコードを実行するには、予め、
Microsoft ActiveX Data Objects 6.X Library
を参照設定する必要があります。
Private Const TARGET_FOLDER As String = "C:\Datas\" Private Const TARGET_NAME As String = "CSV10.csv" Public Sub readByAdo() Dim cn As ADODB.Connection Dim cmd As ADODB.Command Dim rs As ADODB.Recordset Dim lRecords As Long Dim i As Long Dim sgStart As Single Dim sgStop As Single sgStart = Timer On Error GoTo ERR_EXIT Set cn = New ADODB.Connection cn.Open "Provider=Microsoft.ACE.OLEDB.12.0;" _ & "Data Source=" & TARGET_FOLDER & ";" _ & "Extended Properties=""Text;" _ & "HDR=Yes;" _ & "FMT=Delimited""" Set cmd = New ADODB.Command Set cmd.ActiveConnection = cn cmd.CommandType = adCmdText 'データを取得するためのSQL cmd.CommandText = "SELECT * FROM [" & TARGET_NAME & "]" Set rs = New ADODB.Recordset 'カーソルとロックの設定 rs.CursorLocation = adUseServer rs.CursorType = adOpenForwardOnly rs.LockType = adLockReadOnly rs.Open cmd 'rs.RecordCountを取得するには '1.adUseClientを使用する ' (CursorTypはどれを指定しても可) 'または '2.adUseServerを使用し、かつ ' CursorTypeを次のいずれかにする ' adOpenKeyset ' adOpenStatic ' lRecords = rs.RecordCount lRecords = 10 Do Until rs.EOF For i = 0 To rs.Fields.Count - 1 Debug.Print rs.Fields(i).Value & " "; Next i Debug.Print "" rs.MoveNext Loop ERR_EXIT: If Err.Number <> 0 Then 'エラーがあればログ出力 Debug.Print "[" & Err.Source & "]" & "[" & CStr(Err.Number) & "] " & Err.Description End If If Not rs Is Nothing Then If rs.State = adStateOpen Then 'レコードセットのインスタンスが生成されていて、かつ開いていたら、閉じる rs.Close End If Set rs = Nothing End If If Not cmd Is Nothing Then 'アクティブコネクションへの参照を破棄する Set cmd.ActiveConnection = Nothing Set cmd = Nothing End If If Not cn Is Nothing Then If cn.State = adStateOpen Then 'コネクションのインスタンスが生成されていて、かつ接続済みならば、閉じる cn.Close End If Set cn = Nothing End If sgStop = Timer Debug.Print "Done. [ " & Format$(sgStop - sgStart, "0.00") & " sec.][ " & CStr(lRecords) & " records.]" End Sub
サンプルデータ
ヘッダ行あり。
10列×10レコード。
F1,F2,F3,F4,F5,F6,F7,F8,F9,F10
AA0000001,AB0000001,AC0000001,AD0000001,AE0000001,AF0000001,AG0000001,AH0000001,AI0000001,AJ0000001
AA0000002,AB0000002,AC0000002,AD0000002,AE0000002,AF0000002,AG0000002,AH0000002,AI0000002,AJ0000002
AA0000003,AB0000003,AC0000003,AD0000003,AE0000003,AF0000003,AG0000003,AH0000003,AI0000003,AJ0000003
AA0000004,AB0000004,AC0000004,AD0000004,AE0000004,AF0000004,AG0000004,AH0000004,AI0000004,AJ0000004
AA0000005,AB0000005,AC0000005,AD0000005,AE0000005,AF0000005,AG0000005,AH0000005,AI0000005,AJ0000005
AA0000006,AB0000006,AC0000006,AD0000006,AE0000006,AF0000006,AG0000006,AH0000006,AI0000006,AJ0000006
AA0000007,AB0000007,AC0000007,AD0000007,AE0000007,AF0000007,AG0000007,AH0000007,AI0000007,AJ0000007
AA0000008,AB0000008,AC0000008,AD0000008,AE0000008,AF0000008,AG0000008,AH0000008,AI0000008,AJ0000008
AA0000009,AB0000009,AC0000009,AD0000009,AE0000009,AF0000009,AG0000009,AH0000009,AI0000009,AJ0000009
AA0000010,AB0000010,AC0000010,AD0000010,AE0000010,AF0000010,AG0000010,AH0000010,AI0000010,AJ0000010
実行結果
call readByAdo
AA0000001 AB0000001 AC0000001 AD0000001 AE0000001 AF0000001 AG0000001 AH0000001 AI0000001 AJ0000001
AA0000002 AB0000002 AC0000002 AD0000002 AE0000002 AF0000002 AG0000002 AH0000002 AI0000002 AJ0000002
AA0000003 AB0000003 AC0000003 AD0000003 AE0000003 AF0000003 AG0000003 AH0000003 AI0000003 AJ0000003
AA0000004 AB0000004 AC0000004 AD0000004 AE0000004 AF0000004 AG0000004 AH0000004 AI0000004 AJ0000004
AA0000005 AB0000005 AC0000005 AD0000005 AE0000005 AF0000005 AG0000005 AH0000005 AI0000005 AJ0000005
AA0000006 AB0000006 AC0000006 AD0000006 AE0000006 AF0000006 AG0000006 AH0000006 AI0000006 AJ0000006
AA0000007 AB0000007 AC0000007 AD0000007 AE0000007 AF0000007 AG0000007 AH0000007 AI0000007 AJ0000007
AA0000008 AB0000008 AC0000008 AD0000008 AE0000008 AF0000008 AG0000008 AH0000008 AI0000008 AJ0000008
AA0000009 AB0000009 AC0000009 AD0000009 AE0000009 AF0000009 AG0000009 AH0000009 AI0000009 AJ0000009
AA0000010 AB0000010 AC0000010 AD0000010 AE0000010 AF0000010 AG0000010 AH0000010 AI0000010 AJ0000010
Done. [ 0.31 sec.][ 10 records.]
参考データ
Open + Line Input との速度比較
Open ステートメント + Line Input ステートメントを使用したコードと速度を比較してみた。
使用したコード
Public Sub readByOpen() Dim iFileNo As Integer Dim sLine As String Dim vLineItems As Variant Dim lRecords As Long Dim vRecords() As Variant Dim sgStart As Single Dim sgStop As Single sgStart = Timer lRecords = 0 ' ReDim vRecords(lRecords) ReDim vRecords(9) iFileNo = FreeFile Open TARGET_FOLDER & TARGET_NAME For Input As iFileNo 'ヘッダ行読み捨て Line Input #iFileNo, sLine Do Until EOF(iFileNo) Line Input #iFileNo, sLine vLineItems = Split(sLine, ",") ' ReDim Preserve vRecords(lRecords) vRecords(lRecords) = vLineItems lRecords = lRecords + 1 Loop Close iFileNo sgStop = Timer Debug.Print "Done. [ " & Format$(sgStop - sgStart, "0.00") & " sec.][ " & CStr(lRecords) & " records.]" End Sub
結果
単位は秒。
各レコード、各フィールドの値のDebug.Printなし。
レコード数が少ない場合は、Open + Line Input の方が速い。
100,000件以上では、ADOの方が速く、件数が増えるほど差が大きくなっている。
レコード数 | readByAdo | readByOpen Preserveあり | readByOpen Preserveなし |
---|---|---|---|
10 | 0.28 | 0.00 | 0.00 |
10,000 | 0.33 | 0.11 | 0.11 |
100,000 | 0.72 | 1.09 | 0.92 |
500,000 | 2.43 | 10.77 | 4.53 |
1,000,000 | 4.54 | 33.50 | 9.09 |
カーソル、LockTypeによる影響
今回は、省略しましたが、
- CursorLocation
- CursorType
- LockType
が変わると、処理時間も変わるようです。
機会があれば、まとめて掲載するかも知れません。
類似記事
2019/10/26 追記
UTF-8 の読み込み処理として、ADODB.Recordset と ADODB.Stream の比較記事があります。
z1000s.hatenablog.com
z1000s.hatenablog.com
【VBA】任意のRangeの先頭1行を除いたRangeを簡単に取得する
Excelでデータを入力していると、1行目にヘッダ行があって、実際のデータは2行目からということはよくあると思います。
VBAで何らかの処理を行っている際に、ヘッダ行を含んだRangeは取得済みだけど、ヘッダ行を除いた部分をRangeとして取得したい場合、今までは、最終行を取得して2行目から最終行までと指定していたのですが、別のアプローチがあることに気が付いてしまいました。
2019/5/22 修正
ヘッダ行を含むデータのRangeに対して、
1.ヘッダ行分、下にOffset
2.ヘッダ行分、行数をマイナスResize
でいけるんじゃない?
コメント欄で、jinoji さんからのご指摘にあるように、上記の順番では特定の条件下でエラーになるため、以下のようにするべきでしたので訂正しました。
ヘッダ行を含むデータのRangeに対して、
- ヘッダ行分、行数をマイナスResize
- ヘッダ行分、下にOffset
Public Sub hoge() Dim r As Range Set r = Range("A1:B10") Debug.Print "Original Range : " & r.Address(False, False) ' Debug.Print "ヘッダ行除外 Range : " & r.Offset(1, 0).Resize(r.Rows.Count - 1).Address(False, False) Debug.Print "ヘッダ行除外 Range : " & r.Resize(r.Rows.Count - 1).Offset(1, 0).Address(False, False) End Sub
実行結果
call hoge Original Range : A1:B10 ヘッダ行除外 Range : A2:B10
ほら、大丈夫!A1がA2に変わってる。
最終行を取得しなくてもいいし、1行で取得できるし、ちょっとお得な気分。
途中に結合されたセルがあっても大丈夫みたい。
でも、最初のRangeの行数が1だと、実行時エラーになりますからね。
Offset と Resize の指定を変えれば、列方向でも出来そうだ。
【VBA】Excelで、製品の販売価格の更新情報を持つマスタから、いろいろな販売日の価格を取得する
難しく書いたけど、要するに
ある製品の販売価格が、不定期に変わっていて、その履歴が残っている。
じゃあ、「任意のタイミングでの販売価格はいくらか?」を取得するというもの。
元ネタはこちら
https://twitter.com/ia02003812/status/1122857099669598209
ワークシート関数だけでも出来そうだけど、データ件数が多いとなるとレスポンスが悪そう。
VLookUpでは、複数条件で絞り込めなさそうなので多分NG.
MAXIFS を使えば出来そうだけど、うちのExcelは 2013 なので使えない。
他にも方法はあるのだろうけど、今回は(今回も?)VBAで・・・
データは下に載せたような感じ。
いつもの如く、乱数使いまくって・・・
データ作成のコードも下の方に載せてあるので、興味のある方はどうぞ。
同じデータは作れませんけど、近いものは作れるはずなので・・・
価格履歴:各製品の販売価格の更新情報を持つマスタ(製品名、販売価格、適用開始年月日)
重要:価格履歴データは適用開始日が昇順でソートされていないと、掲載したコードは正しく動きません。
販売トラン:各製品の販売実績データ(販売日、製品名、販売数)
「データの名称が、下記のコード中の名称と違う」とか突っ込まないで下さい。
問題点としては、販売トランにある販売日が、価格履歴の価格適用開始日と一致する保証がないので、通常の完全一致の検索が出来ない。
これを解決する手段が必要。
これについては、Dictionary を使用して、以下のようにデータを格納し、その中から該当データを取得出来るようにした。
Key:製品名
Item:「販売価格」、「適用開始年月日」をペアにした物の配列
Dictionary への動的配列の格納は、以前やっているので特に問題はない。
z1000s.hatenablog.com
テスト用データ生成コードで使っている定数とかは、上の「販売価格 更新処理コード」に記載されているので、上のコードと同じモジュールに貼り付けて使って下さい。
実行結果
製品種類数:200
価格履歴件数:8,072
販売データ件数:10,000
所要時間:0.8 ~ 0.9 秒
でした。
遅くはないと思うけど、比べる物が無いので・・・
おまけ
「(0)(0)って何?」という方向けの、"よくわからないかもしれない" 解説のようなもの。
dicItemInfo_.Item(sItemName)(0)(0) vaItemInfo(0)(0)
配列の要素が配列なので、こういう記述になります。ハイ。
例えば
a(2)
という配列があるとして、
a(0)の要素が、b という配列の場合、b(0)を参照するには
a(0)(0)
という指定をします。
Public Sub foo() Dim a(2) Dim b(1) b(0) = "B00" b(1) = "B01" a(0) = b b(0) = "B10" b(1) = "B11" a(1) = b Debug.Print "A00 : " & a(0)(0) Debug.Print "A01 : " & a(0)(1) Debug.Print "A10 : " & a(1)(0) Debug.Print "A11 : " & a(1)(1) End Sub
実行結果
call foo A00 : B00 A01 : B01 A10 : B10 A11 : B11
本当は、Dictionary の Item には、構造体(ユーザー定義型)を入れたかったんですよ。
でも、出来ないみたいだったので、やむなく配列で代用しました。
その結果がこれです。
【VBA】Excelはアクティブシートが変わると、処理時間が変わる場合があるようだ
いつもの如く、怪しげな事(?)をゴニョゴニョとやっていて、
「あれ、さっきより処理速くね?」となったので・・・
経緯
ワークシートに50万件ほどのデータがあって、そいつにフィルターを掛けて外しての繰り返しをやっていたら、何かの拍子に処理時間が早くなったんですよ。
調べてみたら、フィルター処理を行う時に、
フィルターを適用するワークシートをアクティブにしているより、
フィルターを適用しないワークシートをアクティブにしておいた方が
速かったんですよ。
もちろん
With Application .ScreenUpdating = False .EnableEvents = False .Calculation = xlCalculationManual End With
は適用した上ですよ。
ブックには、式が1つもないので、下2つは、ほとんど意味がないような気がするけど、お約束なので・・・
結果
とりあえず、というか、いきなり結果から。
速度順に並べたが、「フィルターを適用するシート以外のシート」をアクティブにしたケースが全て上位になっている。率にして、15%以上の差が出ており、誤差と言える値ではなさそうである。
「平均処理時間」は、5回実行した結果の平均値。
アクティブシート | ScreenUpdating | WindowState | 平均処理時間(秒) | 備 考 |
非フィルター適用シート | False | xlMinimized | 16.31 | |
非フィルター適用シート | False | xlNormal | 16.32 | Worksheet.Visible = False |
非フィルター適用シート | False | xlNormal | 16.35 | |
非フィルター適用シート | True | xlMinimized | 16.46 | |
非フィルター適用シート | True | xlNormal | 16.65 | Worksheet.Visible = False |
非フィルター適用シート | True | xlNormal | 16.67 | |
フィルター適用シート | False | xlNormal | 18.85 | |
フィルター適用シート | False | xlMinimized | 18.86 | |
フィルター適用シート | True | xlMinimized | 21.04 | |
フィルター適用シート | True | xlNormal | 25.13 |
コード
Private Const KEY_COL As Long = 1 Private Const DATA_SHEET_NAME As String = "Data" Private Const KEY_SHEET_NAME As String = "Key" Private Const HEADER_ROWS As Long = 1 Private Const MAX_KEYS_COUNTS As Long = 50 Private Const MAX_DATAS_COUNTS As Long = 500000 Public Sub queryByAutoFilter() Dim ws As Worksheet Dim r As Range Dim lEndRow As Long Dim sgStart As Single Dim sgStop As Single Dim vKeys() As Variant Dim i As Long Dim lMatchCount As Long With Application .ScreenUpdating = False ' .ScreenUpdating = True .EnableEvents = False .Calculation = xlCalculationManual .WindowState = xlNormal ' .WindowState = xlMinimized End With sgStart = Timer Set ws = Worksheets(DATA_SHEET_NAME) lEndRow = MAX_DATAS_COUNTS + HEADER_ROWS '検索対象キー値取得 Call getKeys(vKeys) ReDim sKeys(LBound(vKeys) To UBound(vKeys)) For i = LBound(vKeys) To UBound(vKeys) sKeys(i) = CStr(vKeys(i)) Next i With ws 'Filter対象レンジを設定 Set r = .Range(.Cells(1, KEY_COL), .Cells(lEndRow, KEY_COL)) End With With r For i = LBound(sKeys) To UBound(sKeys) 'AutoFilterクリア .AutoFilter 'Filter実行 .AutoFilter Field:=1, Criteria1:=sKeys(i), Operator:=xlFilterValues If .SpecialCells(xlCellTypeVisible).Count > HEADER_ROWS Then lMatchCount = lMatchCount + .SpecialCells(xlCellTypeVisible).Count - HEADER_ROWS End If Next i 'AutoFilter解除 .AutoFilter End With sgStop = Timer With Application .ScreenUpdating = True .EnableEvents = True .Calculation = xlCalculationAutomatic .WindowState = xlNormal End With Debug.Print Format$(sgStop - sgStart, "0.00") End Sub Private Sub getKeys(ByRef vKeys() As Variant) Dim lEndRow As Long Dim lItems As Long Dim lValue As Long Dim i As Long ReDim vKeys(MAX_KEYS_COUNTS - 1) lEndRow = MAX_KEYS_COUNTS + HEADER_ROWS With Worksheets(KEY_SHEET_NAME) For i = HEADER_ROWS + 1 To lEndRow vKeys(i - HEADER_ROWS - 1) = .Cells(i, 1).Value Next i End With End Sub
まとめ(のようなもの)
- フィルターを適用するワークシートをアクティブにしない方が速かった。
- ScreenUpdateing = False は、フィルターを適用するワークシートがアクティブな場合には、効果が大きいが、そうでない場合は、効果がほとんど認められなかった。
- Windowを最小化しても、あまり高速化へのメリットはなかった。
今回のテストでは、ScreenUpdatingの状態に関わらず、フィルターを適用するワークシートをアクティブにしない方が速くなっている。
では、フィルターを適用するワークシートが「表示されていなければ、いいのか?」というと、
「Windowを最小化」により該当ワークシートを非表示状態にして効果が認められるのは、
フィルターを適用するワークシートをアクティブにして、かつ ScreenUpdating = True の場合だけだったので、表示されていなければ、効果があるわけではないようだ。
一方で、「該当ワークシートを非表示にする」というのは、別のワークシートをアクティブ化するという事と同等なので、これは「効果はある」ことになる。
結局の所、ScreenUpdatingがFalseになっていても、フィルターを適用するワークシートがアクティブの場合には、アクティブシートであるが故の何かが、裏で動いていると考えるのが妥当なのかもしれない。
というか、私の頭ではそれしか思い浮かばない。
誰か、わかる方がいらっしゃいましたら教えて下さい。
フィルター以外でも効果があるのかは、要確認。
でも、きっと・・・
忘れて何もしないような気がする。
追記
行削除(2019/5/5)
行の削除処理で比較してみた。
Public Sub deleteRows(ByVal acsh As Long, ByVal doScreenUpdating As Boolean) Const END_ROW As Long = 10000 Dim ws As Worksheet Dim sgStart As Single Dim sgStop As Single Dim i As Long sgStart = Timer Application.ScreenUpdating = doScreenUpdating If acsh = 1 Then Worksheets(1).Activate Else Worksheets(2).Activate End If Set ws = Worksheets(1) With ws .Cells.ClearContents .Cells(1, 1).Value = 1 .Cells(2, 1).Value = 2 .Range("A1:A2").AutoFill Destination:=.Range("A1:A" & CStr(END_ROW)), Type:=xlFillDefault For i = END_ROW To 1 Step -2 .Rows(i).Delete Next i End With Worksheets(1).Activate Application.ScreenUpdating = True sgStop = Timer Debug.Print "Active Sheet:" & CStr(acsh), Format$(sgStop - sgStart, "0.00") End Sub
結果
Active Sheet: 1 ScreenUpdating: True Time[sec]: 3.64 Active Sheet: 1 ScreenUpdating: False Time[sec]: 0.97 Active Sheet: 2 ScreenUpdating: True Time[sec]: 0.89 Active Sheet: 2 ScreenUpdating: False Time[sec]: 0.84
やっぱり、処理するシート以外をアクティブシートにした方が速い。
その場合には、ScreenUpdating = False としても、大きな効果は認められない。(見えない所で処理しているのだから、当たり前といえば当たり前か・・・)
結構使えるかもしれない・・・
【VBA】割り算を使わないで、数値の2進数表示を取得する(負値対応済み)
最初に断っておきますが、この記事は半分ネタです。
あえて、面倒くさいことしてます。
私がやりたかっただけです。
基本に則って2進表示を求めたい方は、
とか、して下さい。
但し、10進数の2進数表示した文字列を取得する関数は、探せば結構出てきますが
大体は、2で割って余りを求めて・・・
でも、負の数まで考慮されているものはほとんど無いようです。
私が見つけた1件でも、値によってはオーバーフローして、十分な検証はされていないようでした。
WorksheetFunction.Dec2Bin は、
数値 < -512 または数値 > 511 の場合、エラー値 #NUM! が返されます。
WorksheetFunction.Dec2Bin メソッド (Excel)
と、あまり使い物にならないかもしれません。
コード その1
割り算を使った方法は、上位の桁から処理していくが、割り算を使用しないということは、その逆で、下位から処理を行っていきます。
2^0 の桁 から Integerなら、2^15 の桁に向かって処理を行います。
流れとしては
最初に、変換したいデータと 1 ( = 2^0 )のAnd を取る。
奇数の場合、2^0の桁は 1 なので
1 And 1 ===> 1
となり、
偶数の場合、2^0の桁は 0 なので
0 And 1 ===> 0
となる。
And を取った結果が、2^0 の桁の値となる。
これを桁を、2^1の桁、2^2の桁と、上位方向にずらして繰り返していく。
「And演算子って何?」とか、
「なんで数値同士でAndなの?」とか
「A And B って、A かつ B じゃないの?」
という方は、以下のリンクをどうぞ。
(解説の下の方に書いてあります。)
docs.microsoft.com
以下が、その処理を行うコードです。
但し、Integer も Long も符号付き故に、大抵は、最上位bitでの処理に苦しみます。(多分、私だけではないと思う。)
結局は、それを回避するためにゴチャゴチャと・・・
微妙に違うところはありますが、ほぼ分かると思います。
コード その2
VBAで、エンディアンの変換をやろうとしたら、やっぱりハマった - 空腹おやじのログと備忘録 のおまけで書いたコードと似たような手法。
最初に変換したい値を16進の文字列に変換して、16進数1文字につき、2進数4文字に変換していく。
値の正負を意識する必要がない。
オーバーフローの心配もなく、手っ取り早い。
お気軽に使いたいなら、こちらの方がおすすめ。
Integer(16bit)版のみ掲載
Long(32bit)版が欲しい方は、適当にアレンジして下さい。そんなに難しくはないと思いますので。
あぁ、今日も自己満足の世界に・・・
【VBA】For ループの罠(?)
次のコードを実行するとどうなると思いますか?
Public Sub foo() Dim i As Long For i = &H7FFFFFFE To &H7FFFFFFF Debug.Print i Next i End Sub
もうひとつ
Public Sub bar() Dim i As Long i = &H7FFFFFFE Do Debug.Print i i = i + 1 Loop Until i > &H7FFFFFFF End Sub
ちなみに、
&H7FFFFFFE => 2147483646
&H7FFFFFFF => 2147483647
です。
どちらも、
2147483646 2147483647
となると思った方
・
・
・
・
・
残念ですが、半分だけ正解です。
bar の方が、予想はしやすいと思いますが・・・
どちらも 2147483646 と 2147483647 は出力されます。
でもその後に、どちらも、オーバーフローが発生します。
上記Forループの場合、変数 i がLongなので、Longの上限値である &H7FFFFFFF までループ可能かと思っていたら、内部で&H7FFFFFFF + 1 してからループを終了するみたいです。
( i = &H7FFFFFFF の処理を終了後、i をインクリメントして i > &H7FFFFFFF となったことでループ終了と判断していると推測される)
ただ、For ループの方のスクリーンショットで見える -2147483648 は、Long の最小値(&H80000000)であるので、この状況についてはよくわからない。
Longの上限(&H7FFFFFFF)を超えた &H80000000(正の値)が、Longの変数領域に負の値の &H80000000 として存在しているためなのか?
内部でのBitは &H80000000 で一致していても、実際には、Longの上限(&H7FFFFFFF)+1(+2147483648 > 0)となるためオーバーフローと判断されたのだろうか?
ちなみに、イミディエイトウィンドウで
? &H7FFFFFFF + 1
とやっても、オーバーフローが発生する。
上記のbarの方は予想はできるけど、For の挙動は予想できなかった。
別の作業で同様の処理をやっていて、順調に進んでいった最後のところで
「えっ、なんでオーバーフローすんの?」って驚いた。
その原因がこんな感じでした。
結 論
- For ループは、ループ変数の型の上限値までループさせるとオーバーフローする。
- ループ変数の型は、余裕のあるサイズにしよう!!!
- 境界には気をつけよう
あぁ、今日も余計な手間で疲れた・・・
回答が・・・
後からブロググループのページを見て・・・
がっかり orz
なんのために結果を隠したんだよ・・・
最初から答えが出てるじゃん。
当該画像の前に別の画像を追加しても、ブログページに表示される画像は変わらないんですね。
しょうがないので、最初から隠さずに全部表示することにしました。
つまらん!