第32回.売上一覧（伝票合計の一覧）を作成(2)
エクセルで顧客管理を作ろう、
作成された、「売上明細」より、伝票合計の一覧を作成します、
前回に引き続き、３パターン目のやり方になります。
今回のプログラムは難読ですよ。
配列をいじくりまわしています。（笑）
先に、エクセルのサンプル をアップします。
ダウンロード用の別サイトが表示されます。
とにかく、プログラムを。
「Mod売上一覧」に以下を追加します。
Sub 売上一覧作成()
Dim i1 As Long, i2 As Long
Dim lngCol As
Long
Dim varAry1 As Variant '売上明細
Dim varAry2 As Variant
'検索項目
Dim varAry3 As Variant '検索途中結果
Dim varAry4 As Variant
'検索結果
Dim varSearch1 As Variant '検索FROM
Dim varSearch2 As Variant
'検索TO
Dim varOldCd1 As Variant '削除のブレーク
Dim varOldCd2 As
Variant '伝票番号のブレーク
Dim blnFind As Boolean '検索結果判定
Dim rtn As
Integer
rtn = MsgBox("売上一覧を作成してもよろしいですか？", vbYesNo, "確認")
If rtn
= vbNo Then Exit Sub
Debug.Print Now
Call
マクロ開始処理
Application.StatusBar =
"作業用の配列を作成中。"
DoEvents
'検索結果範囲をクリア
Range(Rows(開始セル取得("売上一覧").Row
+ cns間隔),
Rows(Cells.SpecialCells(xlLastCell).Row)).Delete
'検索指定を配列に入れる。１行余分に配列を作成し、列検索を保存用とする。
varAry2
= Range(開始セル取得("売上一覧"), _
Cells(開始セル取得("売上一覧").Row + 3,
Cells.SpecialCells(xlLastCell).Column))
DoEvents
With
シート取得("売上明細")
varOldCd1 = "" '削除
varOldCd2 = ""
'伝票番号
'売上明細のデータ範囲の全てを配列に入れる
i1 = .Cells(Rows.Count,
開始セル取得("売上明細").Offset(0, 1).Column).End(xlUp).Row
varAry1 =
.Range(開始セル取得("売上明細"), .Cells(i1,
.Cells.SpecialCells(xlLastCell).Column))
DoEvents
'列検索し列数を保存する。後の処理を高速にする為。
For
i2 = LBound(varAry2, 2) To UBound(varAry2, 2)
varAry2(4, i2) =
明細列取得(varAry1, varAry2(1,
i2))
Next
'売上明細の配列から、削除・伝票番号でブレーク毎に取り出す。
For i1 =
LBound(varAry1, 1) + 1 To UBound(varAry1, 1)
Application.StatusBar = i1
& "/" & UBound(varAry1, 1) & "
行目を処理中"
DoEvents
blnFind = True
'以下で検索対象外と判定された場合にFalseにする。
'検索列全てについて、検索指定と比較判定する。
For i2 =
LBound(varAry2, 2) To UBound(varAry2, 2)
lngCol = varAry2(4,
i2)
'検索項目名が存在し、検索条件が指定されている場合。
If lngCol > 0 And
_
Not (IsEmpty(varAry2(1, i2)) Or IsEmpty(varAry2(2, i2)))
Then
If Left(varAry2(2, i2), 1) = "*" Then '部分一致
If
InStr(varAry1(i1, lngCol), Mid(varAry2(2, i2), 2)) = 0
Then
blnFind = False
Exit
For
End If
Else '完全一致
varSearch1 =
varAry2(2, i2)
varSearch2 = varAry2(3, i2)
If
IsEmpty(varSearch2) Then
varSearch2 =
varSearch1
End If
If varAry1(i1, lngCol) <
varSearch1 Or _
varAry1(i1, lngCol) > varSearch2
Then
blnFind = False
Exit
For
End If
End If
End
If
Next
If blnFind = True Then
'検索対象の場合
'削除、伝票番号がブレークした場合のみ処理する。
If varOldCd1 <>
varAry1(i1, 1) Or _
varOldCd2 <> varAry1(i1, 2)
Then
If IsEmpty(varAry3) Then
ReDim
varAry3(UBound(varAry2, 2) - LBound(varAry2, 2),
0)
Else
ReDim Preserve varAry3(UBound(varAry2, 2) -
LBound(varAry2, 2), UBound(varAry3, 2) + 1)
End If
For
i2 = LBound(varAry2, 2) To UBound(varAry2, 2)
lngCol = varAry2(4,
i2)
If lngCol > 0 Then
varAry3(i2 -
LBound(varAry2, 2), UBound(varAry3, 2)) = varAry1(i1, lngCol)
End
If
Next
varOldCd1 = varAry1(i1, 1)
'削除
varOldCd2 = varAry1(i1, 2) '伝票番号
End If
End
If
Next
End With
Application.StatusBar =
"検索結果をシートへ設定中"
DoEvents
If Not IsEmpty(varAry3)
Then
'次元を入れ替える
ReDim varAry4(LBound(varAry3, 2) To UBound(varAry3,
2), LBound(varAry3, 1) To UBound(varAry3, 1))
For i1 = LBound(varAry3, 1)
To UBound(varAry3, 1)
For i2 = LBound(varAry3, 2) To UBound(varAry3,
2)
varAry4(i2, i1) = varAry3(i1,
i2)
Next
Next
'シートに貼り付ける
Range(開始セル取得("売上一覧").Offset(cns間隔,
0), _
開始セル取得("売上一覧").Offset(UBound(varAry4, 1) - LBound(varAry4, 1) +
cns間隔, _
UBound(varAry4, 2) - LBound(varAry4, 2))) = varAry4
End
If
Call マクロ終了処理
Debug.Print Now
End
Sub
Function 明細列取得(ByVal varAry As Variant, ByVal strName As String) As
Long
Dim i As Long
明細列取得 = -1
If strName = "" Then
Exit
Function
End If
For i = LBound(varAry, 2) To UBound(varAry,
2)
If varAry(LBound(varAry, 1), i) = strName Then
明細列取得 =
i
Exit Function
End If
Next
If 明細列取得 < 0
Then
MsgBox ("検索項目[" & strName & "]が存在しません。")
End If
End
Function
個々の命令は、特別なものはありません。
個別には解説のしようが無いように思います。
全体としては、以下の処理をしています。
検索条件部分を配列varAry2に入れる
↓
売上明細の全データを配列varAry1に入れる
↓
varAry1の全行を処理
varAry2の全列を処理
検索条件に一致するかを判定
↓
検索対象の場合、配列varAry3に入れる
↓
配列varAry3の縦横を入れ替え、配列varAry4に入れる
↓
配列varAry4をシートに貼り付ける
DoEventsが随所に入っています。
これは、ステータスバーへの表示と、
時間がかり、かつメモリを食うような処理の場合、画面がフリーズしたような状態になるのを防いでいます。
動的配列の要素数の変更は、最下位の次元のみですので、
配列varAry3は、列が１次元、行が２次元で使用しています。
この為、シートに貼り付ける前に、配列varAry4に次元を入れ替えてから、
シートに貼り付けています。
処理時間ですが、
前回は、計測に間違いがあったようです、件数が違いました。
改めて、データ、3万件での処理時間です。
フィルターオプションを使用し、行毎コピー：約5分
フィルターを使い、セル範囲を値でコピー：3秒
今回の配列を使っての処理：53秒
処理方法もまちまちですし、前者２通りは、絞り込みまでやっていませんが、
２番目の処理が、ずば抜けて早いです。
やはり、エクセルでは、セル範囲を一括で処理することが、最も効率が良いようです。
しかし、セル範囲を一括で処理すると、どうしても複雑な処理は出来なくなります。
エクセルでは、まずは、セル範囲を一括で処理する方ほを考えるべきでしょう。
どうしても、複雑な処理が必要な場合は、やはり配列処理を工夫する必要が出てきます。
セル範囲を一括で処理するためには、シートを工夫する必要があります。
そして、これが、エクセルでは最も重要な事です。
エクセルの機能を無視したシートを作成し、力技でVBAを書くのは、
いかにも効率が悪いのです。
とはいえ、本ソフトでは、今回のプログラムを採用します。
理由は、今後の機能拡張時に素早く対応できるからです。
必要なデータのみ適切に抽出する為には、どうしても今回のようなプログラムが必要です。
フィルターは便利なのですが、バージョンでの違い（日付が問題です）も考慮する必要があります。
どうでしたでしょうか。
大量データから、複数条件で、複数データの取り出しは、
エクセルは、どうしても苦手な処理だと感じます。
やはり、外部DBを使用して、データを保管しておき、
DBよりSQL文で取り出す処理に比べると、処理時間も拡張性も劣るように思います。
そうですね、本シリーズが終了したら、
アクセス(Access)にデータを保存したり、取り出したりするサンプルでもやりましょうか。
別にアクセスが入っていないPCでも使う事はもちろん、プログラムを作ることも出来ます。
それでも、エクセルで処理する利点は多くあります。
まずは、エクセルの機能に合致した、シートの設計を心がけることでしょう。
これにより、プログラムは格段に簡単になります。
プログラムが作りづらかったら、作りやすいように、シートを変更する事も必要です。
さて、次回どうするかですが、どうしましょう。
「納品書」が新規作成しか出来ないので、
「売上一覧」から選択し、該当行の「納品書」を表示させましょうか。
どうするか、これから考えます。
同じテーマ「エクセル顧客管理」の記事
第28回.納品書データをデータベース化(1)
第29回.納品書データをデータベース化(2)
第30回.配列の使い方について
第31回.売上一覧（伝票合計の一覧）を作成(1)
第32回.売上一覧（伝票合計の一覧）を作成(2)
第33回.売上一覧より納品書を作成
第34回.伝票番号の自動採番機能を追加
第35回.メニューを作成
第36回.最終回
その後№1、CSV出力を追加
その後№2、ベクター掲載
新着記事NEW ・・・新着記事一覧を見る
ブール型（Boolean）のis変数・フラグについて｜VBA技術解説(2024-04-05)
テキストの内容によって図形を削除する｜VBA技術解説(2024-04-02)
ExcelマクロVBA入門目次｜エクセルの神髄(2024-03-20)
VBA10大躓きポイント（初心者が躓きやすいポイント）｜VBA技術解説(2024-03-05)
テンキーのスクリーンキーボード作成｜ユーザーフォーム入門(2024-02-26)
無効な前方参照か、コンパイルされていない種類への参照です。｜エクセル雑感(2024-02-17)
初級脱出10問パック｜VBA練習問題(2024-01-24)
累計を求める数式あれこれ｜エクセル関数応用(2024-01-22)
複数の文字列を検索して置換するSUBSTITUTE｜エクセル入門(2024-01-03)
いくつかの数式の計算中にリソース不足になりました。｜エクセル雑感(2023-12-28)
アクセスランキング ・・・ ランキング一覧を見る
1.最終行の取得（End,Rows.Count）｜VBA入門
2.セルのコピー&値の貼り付け（PasteSpecial）｜VBA入門
3.RangeとCellsの使い方｜VBA入門
4.ひらがな⇔カタカナの変換｜エクセル基本操作
5.繰り返し処理（For Next)｜VBA入門
6.変数宣言のDimとデータ型｜VBA入門
7.ブックを閉じる・保存（Close,Save,SaveAs）｜VBA入門
8.並べ替え（Sort）｜VBA入門
9.セルのクリア（Clear,ClearContents）｜VBA入門
10.Findメソッド（Find,FindNext,FindPrevious）｜VBA入門
このサイトがお役に立ちましたら「シェア」「Bookmark」をお願いいたします。
記述には細心の注意をしたつもりですが、
間違いやご指摘がありましたら、「お問い合わせ」からお知らせいただけると幸いです。
掲載のVBAコードは動作を保証するものではなく、あくまでVBA学習のサンプルとして掲載しています。
掲載のVBAコードは自己責任でご使用ください。万一データ破損等の損害が発生しても責任は負いません。