エクセル顧客管理 | 第32回.売上一覧(伝票合計の一覧)を作成(2) | Excelマクロを駆使したカスタマイズ可能なエクセル顧客管理、エクセルVBAの学習教材



最終更新日:2014-11-11

第32回.売上一覧(伝票合計の一覧)を作成(2)


エクセルで顧客管理を作ろう、


作成された、「売上明細」より、伝票合計の一覧を作成します、


前回に引き続き、3パターン目のやり方になります。


今回のプログラムは難読ですよ。


配列をいじくりまわしています。(笑)


先に、エクセルのサンプル をアップします。

ダウンロード用の別サイトが表示されます。


とにかく、プログラムを。


「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
  '検索指定を配列に入れる。1行余分に配列を作成し、列検索を保存用とする。

  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は、列が1次元、行が2次元で使用しています。


この為、シートに貼り付ける前に、配列varAry4に次元を入れ替えてから、

シートに貼り付けています。


処理時間ですが、


前回は、計測に間違いがあったようです、件数が違いました。


改めて、データ、3万件での処理時間です。


フィルターオプションを使用し、行毎コピー:約5分

フィルターを使い、セル範囲を値でコピー:3秒

今回の配列を使っての処理:53秒


処理方法もまちまちですし、前者2通りは、絞り込みまでやっていませんが、

2番目の処理が、ずば抜けて早いです。

やはり、エクセルでは、セル範囲を一括で処理することが、最も効率が良いようです。


しかし、セル範囲を一括で処理すると、どうしても複雑な処理は出来なくなります。


エクセルでは、まずは、セル範囲を一括で処理する方ほを考えるべきでしょう。

どうしても、複雑な処理が必要な場合は、やはり配列処理を工夫する必要が出てきます。


セル範囲を一括で処理するためには、シートを工夫する必要があります。

そして、これが、エクセルでは最も重要な事です。

エクセルの機能を無視したシートを作成し、力技でVBAを書くのは、

いかにも効率が悪いのです。


とはいえ、本ソフトでは、今回のプログラムを採用します。

理由は、今後の機能拡張時に素早く対応できるからです。

必要なデータのみ適切に抽出する為には、どうしても今回のようなプログラムが必要です。

フィルターは便利なのですが、バージョンでの違い(日付が問題です)も考慮する必要があります。



どうでしたでしょうか。


大量データから、複数条件で、複数データの取り出しは、


エクセルは、どうしても苦手な処理だと感じます。


やはり、外部DBを使用して、データを保管しておき、


DBよりSQL文で取り出す処理に比べると、処理時間も拡張性も劣るように思います。


そうですね、本シリーズが終了したら、


アクセス(Access)にデータを保存したり、取り出したりするサンプルでもやりましょうか。


別にアクセスが入っていないPCでも使う事はもちろん、プログラムを作ることも出来ます。



それでも、エクセルで処理する利点は多くあります。


まずは、エクセルの機能に合致した、シートの設計を心がけることでしょう。


これにより、プログラムは格段に簡単になります。


プログラムが作りづらかったら、作りやすいように、シートを変更する事も必要です。



さて、次回どうするかですが、どうしましょう。


「納品書」が新規作成しか出来ないので、


「売上一覧」から選択し、該当行の「納品書」を表示させましょうか。


どうするか、これから考えます。






同じテーマ「エクセル顧客管理」の記事

第33回.売上一覧より納品書を作成
第34回.伝票番号の自動採番機能を追加
第35回.メニューを作成
第36回.最終回
その後1、CSV出力を追加
その後2、ベクター掲載
第1回.どんなソフトにするか

新着記事 ・・・新着記事一覧を見る

SUMIFの間違いによるパフォーマンスの低下について|エクセル関数超技(6月17日)
条件式のいろいろな書き方:TrueとFalseの判定とは|ExcelマクロVBA技術解説(6月15日)
空白セルを正しく判定する方法2|ExcelマクロVBA技術解説(5月6日)
フルパスをディレクトリ、ファイル名、拡張子に分ける|ExcelマクロVBA技術解説(4月15日)
テキストボックスの各種イベント|Excelユーザーフォーム入門(4月9日)
フォルダ(サブフォルダも全て)削除する、Optionでファイルのみ削除|ExcelマクロVBAサンプル集(4月4日)
最後の空白(や指定文字)以降の文字を取り出す|エクセル関数超技(3月26日)
先頭の数値、最後の数値を取り出す|エクセル関数超技(3月26日)
Excelファイルを開かずにシート名をチェック|ExcelマクロVBAサンプル集(3月23日)
数式の参照しているセルを取得する|ExcelマクロVBAサンプル集(3月18日)

アクセスランキング ・・・ ランキング一覧を見る

1.最終行の取得(End,Rows.Count)|ExcelマクロVBA入門
2.RangeとCellsの使い方|ExcelマクロVBA入門
3.徹底解説(VLOOKUP,MATCH,INDEX,OFFSET)|エクセル関数超技
4.Range以外の指定方法(Cells,Rows,Columns)|ExcelマクロVBA入門
5.変数とデータ型(Dim)|ExcelマクロVBA入門
6.セルのコピー&値の貼り付け(PasteSpecial)|ExcelマクロVBA入門
7.セルの参照範囲を可変にする(OFFSET,COUNTA,MATCH)|エクセル関数超技
8.ひらがな⇔カタカナの変換|エクセル基本操作
9.定数と型宣言文字(Const)|ExcelマクロVBA入門
10.CSVの読み込み方法|ExcelマクロVBAサンプル集



  • >
  • >
  • >
  • 売上一覧(伝票合計の一覧)を作成(2)

  • このサイトがお役に立ちましたら「シェア」「Bookmark」をお願いいたします。


    記述には細心の注意をしたつもりですが、
    間違いやご指摘がありましたら、「お問い合わせ」からお知らせいただけると幸いです。
    なお、掲載のVBAコードは自己責任で使ってください。万一データ破損等の損害が発生しても責任は負いません。

    ↑ PAGE TOP