Excel VBA質問箱 IV

当質問箱は、有志のボランティア精神のおかげで成り立っています。
問題が解決したら、必ずお礼をしましょうね。
本サイトの基本方針をまとめました。こちら をご一読ください。

投稿種別の選択が必要です。ご注意ください。
迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。


17764 / 76732 ←次へ | 前へ→

【64416】Re:処理が重い
回答  Hirofumi  - 10/2/4(木) 11:54 -

引用なし
パスワード
   >度々質問する形で申し訳ありません理解した上で使わせていただきたいので
>下記内容をおしえてください

構いませんよ、解らない所は聞いてコードを理解して下さい
下記質問に答える前に、理解して置いて頂きたい事が有ります
今回のコードは、使い回しが利く様に書いた、手持ちのコードを小修正して使って居ます
幾つかのパラメタの変更で、同様の処理を他のListに適用出来る様に書いて有ります
例として、このレスの下の方に在る

【64141】Re:受注データの表示形式について 
ht tp://www.vbalab.net/vbaqa/c-board.cgi?cmd=one;no=64141;id=excel
 
で、私が回答しているコードも今回のコードと殆ど同じです(暇が在ったら見て下さい)
因ってその分解りにくいかも知れませんが?
基本的に、基準のセル位置を決め、其処からのOffsetで全ての位置を出して居ます
また、処理速度を向上する為、配列を使って処理しています

>1.lngRows = .Offset(Rows.Count - .Row).End(xlUp).Row - .Row + 1
>
>A列のデータ範囲を示しているのはなんとなくわかるのですが少しわからないです?
>たとえば1000行データがある場合1000行-1-999-2=997行のデータ範囲という事でしょうか???

此れは、データの総行数を取得しています

行っている処理は、rngListで指定しているセルの最下行、
今回rngListはA1なので、Excel2007以外ではA65536から上に向かってデータの在る最終行位置を取得
この値からrngListの行位置を引いて1加算しています
(通常、列見出しが在る物として、その列見出しを基準にする為、今回はイレギュラーで尚更解りにくいかも?)

汎用性を得る為、Offsetで書いている為に、直接A65536と書けないので
例えばrngListがA1でデータ最終行位置がA1000なら
rngListの.Offset(65536 - 1)でシートの最終行位置を表し、其処から上に見てA1000なら

総行数 = 1000(A1000)-1(A1)+1 =1000行

と成ります

>2. DataSort rngList.Resize(lngRows, clngColumns + 1), vntKeys, vntOrders
>
>データ範囲を並べ替えしているコードみたいですが、後のvntkeysとvntOrdersのところで
>vntKeysが二次元配列の変数が格納vntOrders動的配列の変数のようですが、考えてもわからず
>?です

此れは汎用性の為に行って居ます
今回は、「品番」、「納期」をKeyとし居るので、2Keyで1回整列を行えば善いのですが?
上記「【64141】Re:受注データの表示形式について」の様に、4列をKeyとして整列を行う場合が有ります
Excel2007以前は、1回に整列で3つのKeyまでしか整列出来ませんので、
3つのKeyで1回、1つのKeyで1回の2回整列を行います
この様に、殆ど同じコードなのに、整列部分だけ常に書き換えるのは癪に障ります(汎用性が損なわれます)
因ってこの部分を統一する為、整列KeyとそのKeyに対する昇降順を其々の配列で与えれば
自動的にKeyを割り振り整列回数を決定して整列するプロシージャを実装しています

「Sub DataSort」で
引数:rngScope は整列範囲を与えます
引数:vntKeys は整列するKeyを整列順にrngScopeの先頭列からの列Offsetを列挙しで与えます
   整列範囲先頭列を0列として、例えば
   vntKeys = Array(0, 1, 3, 5, ・・)
引数:vntOrders は上記整列Keyに対する、昇降順を配列で与えます
   上記、整列Keyに対して
   vntOrders = Array(xlAscending, xlDescending, xlAscending,・・)

因って今回は、「品番」、「納期」をKeyとしますので

  '整列Keyを作成(A列順のB列順)
  vntKeys = Array(0, 1)

と成り、昇降順は全て昇順で善いので

  For i = 0 To lngMax
    vntOrders(i) = xlAscending
  Next i

と、整列Keyの数だけ、xlAscendingを並べて居ます

>3.
>If vntTop(1, vntKeys(j) + 1) <> vntData(1, vntKeys(j) + 1) Then
>
>vntTop vntDateがバリアント型で宣言されているので配列なのはなんと無くわかるのですが
>1行目はそのままで列の所を0〜インデックスの最大値までカウントさせて+1させて
>それぞれ比較しているところのイメージがつかめません?

上記の整列Key位置を格納している配列を媒介変数として、2つの配列内の値を比較しています
この場合、vntTop、vntData配列内の列位置は先頭列が1と成るので、
rngListからの列Offsetに対し常に1多い数値と成りますので「vntKeys(j) + 1」と成ります
此れも、汎用性への配慮で、比較するKeyの数が「vntKeys = Array(0, 1)」で決まりますので
「For j = 0 To lngMax」でKeyの数分、配列内のKey位置の値を比較しています
(比較して、1列でも値が違った場合、2つの行は違うと判断しています)

>4.
>vntKeys = Array(0, 1)
>A列B列をそれぞれ二次元配列でvntKeysに格納しているという解釈でいいのでしょうか?

2で説明している様に、
A列、B列の位置をList先頭からの列Offsetで整列順に基底0の1次元配列に列挙しています

>5.
>vntItems(lngStart + 1, 1) _
>          = vntItems(lngStart + 1, 1) + vntData(1, clngItems + 1)
>A列とB列(品番/納期)が同じ場合数量を足す形だと思うのですが?
>i = 1 To lngRows’///1〜データ範囲
>
>vntData = rngList.Offset(i).Resize(, clngColumns).Value
>
>’///配列VntDateにセルA1(1〜データ範囲に移動(カウント)).範囲指定(,4列右までの範囲(E列)).の値
>
>を格納している
>と解釈しているのですが?この構文だと1レコードすべて同じ場合つまりロットNO(D列)
>の値も一緒ではないと合計をしない形におもえています。
>ロット番号も同じデータはなく品番納期のみダブります。
>その部分の計画数を合計した形にしたいのですが・・・・・?

この部分で、lngStart変数は、同値の先頭行位置のrngListからの行Offsetを示して居ます
(同値の先頭とは、上からListを見て行った時、「品番」「納期」のどちらかが違った行と言う意味です)
また、Loopカウンタi変数は、Listの現在(Loopで見て居る行位置)のrngListからの行Offsetを示して居ます
因って、

vntTop = rngList.Offset(lngStart).Resize(, clngColumns).Value

は、同値の先頭の行の1行全てのデータを配列に取得しています
また、

vntData = rngList.Offset(i).Resize(, clngColumns).Value

は、Loopで見ている行の全てのデータを配列に取得しています
此れの、3で説明している、「vntKeys = Array(0, 1)」で指定している列だけ比較しています
この時、0列(品番)と1列(納期)が同じなら、集計用配列vntItemsの同値先頭行位置に集計していますが
配列の要素(この場合、先頭が1で始まる)と実際のListのrngListからの行Offset(0から始まる)と
づれて居ますので「vntItems(lngStart + 1, 1)」の様に1加算しています

尚、汎用性、処理速度を無視して、配列を使わす直接セルを操作する様に書き換えたコードをUpして置きます
操作内容はほぼ同じにして有りますので、ステップ実行して見るとどんな操作を行って居るかが解ると思います
ただし、処理速度は、配列仕様の5倍程度遅く成ります

Option Explicit

Public Sub Ver2maedaosi_4()

'  専用コード

  Dim i As Long
  Dim lngRowEnd As Long
  Dim lngStart As Long
  Dim lngCount As Long
  Dim strProm As String
  
  '画面更新を停止
'  Application.ScreenUpdating = False
  
  With Worksheets("展開")
    '「品番」列の最終行位置の取得
    lngRowEnd = .Cells(Rows.Count, "A").End(xlUp).Row
    If lngRowEnd <= 1 And .Cells(1, "A").Value = "" Then
      MsgBox "データが有りません", vbInformation
      Exit Sub
    End If
    '復帰用(削除Flagを兼ねる)整列Keyを「発注ロット」の後ろの列に作成
    .Cells(1, "E").Value = 1
    .Range(.Cells(1, "E"), .Cells(lngRowEnd, "E")).DataSeries _
        Rowcol:=xlColumns, Type:=xlLinear, Date:=xlDay, _
        Step:=1, Trend:=False
    '品番順の納期順でListを整列
    .Range(.Cells(1, "A"), .Cells(lngRowEnd, "E")).Sort _
        Key1:=.Cells(1, "A"), Order1:=xlAscending, _
        Key2:=.Cells(1, "B"), Order2:=xlAscending, _
        Header:=xlNo, OrderCustom:=1, MatchCase:=False, _
        Orientation:=xlTopToBottom, SortMethod:=xlStroke
    '初めて出て来た「品番」&「納期」の行位置を格納(同値の先頭行位置)
    lngStart = 1
    'Listの2行目〜最終行まで繰り返し
    For i = 2 To lngRowEnd
      '「品番」&「納期」が同値先頭と等しいなら
      If .Cells(lngStart, "A").Value = .Cells(i, "A").Value _
          And .Cells(lngStart, "B").Value = .Cells(i, "B").Value Then
        '「計画数」列の集計(同値先頭行のC列に)
        .Cells(lngStart, "C").Value _
            = .Cells(lngStart, "C").Value + .Cells(i, "C").Value
        'E列の現在行にFlagを立てる
        .Cells(i, "E").Value = Empty
        '削除数を加算
        lngCount = lngCount + 1
      Else
        '同値先頭位置を更新
        lngStart = i
      End If
    Next i
    '削除行を最終行に集める為、E列をKeyとして整列
    .Range(.Cells(1, "A"), .Cells(lngRowEnd, "E")).Sort _
        Key1:=.Cells(1, "E"), Order1:=xlAscending, _
        Header:=xlNo, OrderCustom:=1, MatchCase:=False, _
        Orientation:=xlTopToBottom, SortMethod:=xlStroke
    '削除行が有るなら
    If lngCount > 0 Then
      '不要な行を削除
      .Range(.Cells(lngRowEnd - lngCount + 1, "A"), _
          .Cells(lngRowEnd, "A")).EntireRow.Delete
      strProm = lngCount & "件の削除が実行されました"
    Else
      strProm = "該当行が無い為、削除は行われませんでした"
    End If
    '削除Flag列を削除
    .Cells(1, "E").EntireColumn.Delete
    '列幅の調整
    .Columns.AutoFit
    'B列の書式設定
    .Range(.Cells(1, "B"), .Cells(lngRowEnd - lngCount, "B")).NumberFormat = "yyyy/m/d"
  End With
  
  '画面更新を再開
  Application.ScreenUpdating = True
  
'  Sheets("メニュー画面").Select 'メニュー画面を選ぶ
   
  MsgBox strProm, vbInformation
          
End Sub

0 hits

【64329】処理が重い tetu 10/1/30(土) 18:26 質問
【64330】Re:処理が重い かみちゃん 10/1/30(土) 18:32 発言
【64376】Re:処理が重い tetu 10/1/31(日) 23:18 お礼
【64331】Re:処理が重い Hirofumi 10/1/30(土) 20:07 発言
【64335】Re:処理が重い Hirofumi 10/1/31(日) 0:26 発言
【64337】Re:処理が重い tetu 10/1/31(日) 2:32 発言
【64341】Re:処理が重い Hirofumi 10/1/31(日) 9:13 回答
【64344】Re:処理が重い Hirofumi 10/1/31(日) 9:44 発言
【64377】Re:処理が重い tetu 10/1/31(日) 23:27 質問
【64379】Re:処理が重い Hirofumi 10/2/1(月) 8:03 回答
【64411】Re:処理が重い tetu 10/2/4(木) 1:56 質問
【64416】Re:処理が重い Hirofumi 10/2/4(木) 11:54 回答
【64471】Re:処理が重い tetu 10/2/11(木) 1:12 質問
【64473】Re:処理が重い Hirofumi 10/2/11(木) 9:49 回答
【64372】Re:処理が重い よろずや 10/1/31(日) 20:55 発言
【64378】Re:処理が重い tetu 10/1/31(日) 23:29 お礼
【64380】Re:処理が重い Jaka 10/2/1(月) 9:19 発言
【64412】Re:処理が重い tetu 10/2/4(木) 2:00 お礼
【64413】Re:処理が重い かみちゃん 10/2/4(木) 6:25 発言
【64470】Re:処理が重い tetu 10/2/11(木) 0:23 お礼

17764 / 76732 ←次へ | 前へ→
ページ:  ┃  記事番号:
2610219
(SS)C-BOARD v3.8 is Free