Excel VBA質問箱 IV

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

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


3069 / 13644 ツリー ←次へ | 前へ→

【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 お礼[未読]

【64329】処理が重い
質問  tetu  - 10/1/30(土) 18:26 -

引用なし
パスワード
   ExcelにてCSVファイルを取込で計画数を処理するマクロをくんでいます
65536行ふるに使うとどうしても処理が固まり動かなくなります
どのようにしたらいいかわかるかたおしえてください。
///////////////ボタン1で下記プログラムが動く
Sub 取込()


Application.ScreenUpdating = False '画面の移動停止

Dim vri As Variant 'Vriをvariant型で宣言(メモリー格納)


 vri = Application.GetOpenFilename( _
   Filefilter:="テキストファイル,*.csv,", _
     Title:="他のファイルを開く", _
      MultiSelect:=False)
 'ファイルを開く処理
If vri = False Then
   MsgBox "ファイルは選択されませんでした。", _
    vbOKOnly + vbExclamation, "ファイル名の入力チェック"
    Exit Sub
    'ファイルが選択されない場合エラーメッセージ処理する
Else
   Workbooks.Open (vri)
   '選ばれた場合は選択したCSVファイルを開く
End If
 
Range(Selection, ActiveCell.SpecialCells(xlLastCell)).Select
  Selection.Copy           'CSVファイルのデータ選択してコピー
   Windows("進度.xls").Activate '進度xlsに移動
    Sheets("データ取込").Select  '(データ取込)シートに移動
     Range("A1").Select      'セルA1を選択してデータを貼り付け処理する
      ActiveSheet.Paste


Union(Columns("A"), Columns("C:d"), Columns("F"), _
   Columns("I"), Columns("K")).Select
     Selection.Delete
     '選択した列(不要なデータ)を削除する
Range("F1").Activate 'セルF1に移動する
With Range("F1") 'F1に対しての処理(Withステートメントの開始)
  .FormulaR1C1 = "=RC[-1]&RC[-4]" '文字連結
  .AutoFill Destination:=Range("F1", Range("E" & Rows.Count).End(xlUp).Offset(, 1)), _
   Type:=xlFillDefault
  '指定行までオートフィルする
End With '(Withステートメントの終了)
Range("F1", Range("F65536").End(xlUp)).Select
     Selection.Copy  '文字連結したセルを選択してコピーする
   
Range("G1").Activate 'G1へ移動
 Selection.PasteSpecial Paste:=xlPasteValues '値のみ貼り付け
      
Range("H1").Activate 'H1へ移動
ActiveCell.FormulaR1C1 = "=TRIM(RC[-1])" 'TRIM関数で文字間の不要なスペースを削除
ActiveCell.AutoFill Destination:=Range("H1", Range("G" & Rows.Count).End(xlUp).Offset(, 1)), _
   Type:=xlFillDefault  '指定行までオートフィルする
       
Range("H1", Range("H" & Rows.Count).End(xlUp)).Select
 Selection.Copy '指定行まで、コピー
   Range("I1").Activate 'セルI1へ移動
    Selection.PasteSpecial Paste:=xlPasteValues 'コピーした値を貼り付ける
    

Union(Columns("B"), Columns("E:H")).Select
  Selection.Delete '指定列を削除
  
Range("A1").Activate  'A1セルに移動

  
Range("A1").CurrentRegion.Select '文字入力されている範囲を選択


Columns("A:D").Select '列 A〜Eを選択

Columns("A").Select '列Aを選択する
 Selection.Insert '列Aを挿入する
  Columns("E").Select
   Selection.Copy '列Dを選択してコピーする。
Columns("A").Select 'A列を選択


 Selection.PasteSpecial Paste:=xlPasteValues '貼り付ける
   Application.CutCopyMode = False 'コピー処理を中止する
Columns("E").Select
  Selection.Delete '列Eを選択して削除する。


 Columns("B").Select '列Bを選択
 Selection.Copy 'B列をコピー
 Range("E1").Select 'セルE1を選択
 Selection.PasteSpecial 'B列の値を貼り付け
 Columns("B").Delete 'B列を選択
Range("A1", Range("D" & Rows.Count).End(xlUp)).Select

 
 Selection.Copy '選択したセルをコピーする
 
  Sheets("展開").Activate 'シート("展開")に移動
 If Sheets("展開").Range("A1") = "" Then  'A1が空白なら下記処理を実行
   Range("A1").Select  'セルA1を選択
    Selection.PasteSpecial Paste:=xlPasteValues '値のみ貼り付け
    
 Else
    Sheets("展開").Range("A1").End(xlDown).Offset(1, 0).Select '最終行を選択
     Selection.PasteSpecial    '値を貼り付け
    
    Columns("A:D").Select  '列A〜Cを選択
   
    Selection.Sort Key1:=Range("A1"), Order1:=xlAscending, Key2:=Range("B1") _
    , Order2:=xlAscending, Header:=xlGuess, OrderCustom:=1, MatchCase:= _
    False, Orientation:=xlTopToBottom, SortMethod:=xlPinYin
    
    '品番、納期の順番で昇順に並べ替える
     
    
 End If
 
    
      Application.CutCopyMode = False
      'コピーする処理を中止する
      Columns("B").Select '列Bを選択
       Selection.NumberFormatLocal = "yyyy/m/d" '日付形式に変換
       
     Sheets("メニュー画面").Activate 'メニュー画面に戻る
      Application.ScreenUpdating = True '画面の移動実行
     
     MsgBox "データ取込終了" '取込み終了メッセージ


End Sub
///////ボタン2で下記プログラムが動くこちらで止まる
Sub Ver2maedaosi()
'
' Ver2maedaosi Macro
' マクロ記録日 : 2010/1/30 ユーザー名 : 加藤 鉄也
'

'
Application.ScreenUpdating = False '画面の移動停止
  Sheets("展開").Select 'シート展開を選択
  Columns("B:B").Select '列Bを選択
  Selection.Insert Shift:=xlToRight '右方向に挿入
  Columns("D:D").Select 'D列を選択
  Selection.Insert Shift:=xlToRight '右方向に選択
  Columns("A:A").Select '列Aを選択
  Selection.Copy '列Aに貼り付け
  Columns("B:B").Select '列Bを選択
  ActiveSheet.Paste '貼り付け
  Application.CutCopyMode = False '貼り付けモードをやめる
  Columns("C:C").Select '列Cを選択
    Selection.Copy ' 列Cをコピー
  Columns("D:D").Select ' 列Dを選択
  ActiveSheet.Paste '貼り付け
  Application.CutCopyMode = False '貼り付けモードをやめる
  Range("G1").Select 'G1を選択
  
  ActiveCell.FormulaR1C1 = "=RC[-6]&""_""&RC[-4]" '関数を入力品番と納期を連結
  Selection.AutoFill Destination:=Range("G1").Resize(Range("A65536").End(xlUp).Row), Type:=xlFillDefault
  ' 関数をオートフィルして式をデータがあるところまで入力
 
 
  Range("H1").Select '列H1を選択
  ActiveCell.FormulaR1C1 = _
    "=IF((RC[-7]:R[443]C[-7]=RC[-6])*(RC[-5]:R[443]C[-5]=RC[-4])*COUNTIF(RC[-1]:R1C[-1],RC[-1])>1,"""",RC[-5])"
  Selection.AutoFill Destination:=Range("H1").Resize(Range("A65536").End(xlUp).Row), Type:=xlFillDefault
  ' 関数を入力配列として条件を出して納期の重複行を空白しデーター範囲までアートフィルする
  Columns("H:H").Select '列Hを選択
  
  Range("I1").Select 'セルI1を選択
  Selection.FormulaArray = _
    "=SUM(IF((RC[-8]:R[443]C[-8]=RC[-7])*(RC[-6]:R[443]C[-6]=RC[-5]),RC[-4]:R[443]C[-4]),)"
  '関数を配列として条件をだして同じ納期なら計画数を合計しデーター範囲までアートフィルする
  Selection.AutoFill Destination:=Range("I1").Resize(Range("A65536").End(xlUp).Row), Type:=xlFillDefault
  
  Columns("F:F").Select '列Fを選択
  Selection.Copy     '列Fをコピー
  Columns("J:J").Select '列Jを選択
  ActiveSheet.Paste    '列Jに貼り付け
  Application.CutCopyMode = False '貼り付け状態を中止
  Union(Columns("A"), Columns("H:J")).Select '列AとH~J列を選択
  Selection.Copy 'コピーする
  Columns("K:N").Select '列K~Nを選択
  Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
    False, Transpose:=False '値を貼り付け
  Columns("K:N").EntireColumn.AutoFit '列K~Nの列調整
  Application.CutCopyMode = False
  
  Columns("L:L").EntireColumn.AutoFit '列Lの幅調整
  Columns("K:K").EntireColumn.AutoFit '列Kの幅調整
  Columns("N:N").EntireColumn.AutoFit '列Nの幅調整
  
  Range("A:j").Select 'セルA~Jを選択
  Selection.Delete '削除
  Columns("A:D").Select '列A~Dを選択
  Selection.AutoFilter
  Selection.AutoFilter Field:=2, Criteria1:="<>" 'オートフィルターで空白以外のセルを絞り込む
  Columns("A:D").Select '列A~Dを選択
  Selection.Copy 'コピーする
  Range("E1").Select 'セルE1を選択
  Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
    False, Transpose:=False '貼り付け
  Selection.AutoFilter Field:=2
  Application.CutCopyMode = False '貼り付け状態中止
  Selection.AutoFilter 'フィルター解除
  Columns("A:D").Select '列A~Dを選択
  
  Range("D1").Activate 'セルD1を選択
  Selection.Delete Shift:=xlToLeft '右方向に削除
  Columns("B:B").Select '列Bを選択
  Selection.NumberFormatLocal = "yyyy/m/d" ' 日付け形式に変更
  Sheets("メニュー画面").Select 'メニュー画面を選ぶ
  Application.ScreenUpdating = True '画面の移動実行
  
   MsgBox " 追加処理終了" 'メッセージ画面表示
  
End Sub
他にボタン3,4とありますがこちらは問題ないので省略します


ボタン2で固まりますやはりシートを分けた方がいいのでしょうか・・・?
OS Widows98SE
EXCEl2000
よろしくおねがいします。

【64330】Re:処理が重い
発言  かみちゃん E-MAIL  - 10/1/30(土) 18:32 -

引用なし
パスワード
   こんにちは。かみちゃん です。

>ExcelにてCSVファイルを取込で計画数を処理するマクロをくんでいます
>65536行ふるに使うとどうしても処理が固まり動かなくなります
>どのようにしたらいいかわかるかたおしえてください。

処理をする際に、開いているブックのすべてのシートにどれくらい数式が入っていますか?
再計算を手動にして、実行するとどうなりますか?

あと、コード全体をきちんと見ていませんが、
Selectしないコード、配列を使う、65536行もデータがあるならば、データベースソフトも併用するなどの方法が
考えられます。

【64331】Re:処理が重い
発言  Hirofumi  - 10/1/30(土) 20:07 -

引用なし
パスワード
   >ボタン2で固まりますやはりシートを分けた方がいいのでしょうか・・・?
>OS Widows98SE
>EXCEl2000

多分ですが、

Selection.AutoFilter Field:=2, Criteria1:="<>" 'オートフィルターで空白以外のセルを絞り込む
  Columns("A:D").Select '列A~Dを選択
  Selection.Copy 'コピーする

の所で、抽出箇所が、8192?ぐらいに成るとフリーズした様に成るのかも?

私のWin98、Excel2000で大量のデータをオートフィルタを使って削除しようとすると
フリーズ状態に成った様な気がします

多分で申し訳ないですが、オートフィルタを使わないで
空白行に印を付け、この印で整列し印を下に集めます
そして、印の付いた行を削除します(此れは、Win98、Excel2000でもフリーズしません)
その後、Copyをする様なコードに代えて見るのも手かも?

【64335】Re:処理が重い
発言  Hirofumi  - 10/1/31(日) 0:26 -

引用なし
パスワード
   データは4列(A〜D)?見たいですが?
1、各列は、どんなデータが(数値、日付、文字列)入るのですか?
2、「Sub Ver2maedaosi」の途中の式

 G列「=A1&"_"&C1」
 H列「=IF((A1:A444=B1)*(C1:C444=D1)*COUNTIF(G1:G$1,G1)>1,"",C1)」
 I列「=SUM(IF((A1:A444=B1)*(C1:C444=D1),E1:E444),)」

 は何を行っているのですか?

【64337】Re:処理が重い
発言  tetu  - 10/1/31(日) 2:32 -

引用なし
パスワード
   ▼Hirofumi さん:
>データは4列(A〜D)?見たいですが?
>1、各列は、どんなデータが(数値、日付、文字列)入るのですか?
>2、「Sub Ver2maedaosi」の途中の式
>
> G列「=A1&"_"&C1」
> H列「=IF((A1:A444=B1)*(C1:C444=D1)*COUNTIF(G1:G$1,G1)>1,"",C1)」
> I列「=SUM(IF((A1:A444=B1)*(C1:C444=D1),E1:E444),)」
>
> は何を行っているのですか?
A列には品番 B列には納期C列には計画数D列には発注ロットが入力されています
A列B列のデータをもう一つ作りA,B列に品番C列D列に納期E列計画数F列ロット
と変化しG列でA列とC列を連結していますH列に配列関数なるもので品番と納期がいっしょで
なおかつG列のカウントが1以上のものがある場合値を空白にしています。G列に品番と納期が一つのセルに入力されていますが、納期がだぶっているデータがあるためその部分を後々削除するための式です
I列はダブっているものを計画数だけはほしいため合計しています。
データは展開シートに計画を蓄積していくため最初の内は、いいのですが・・・・
長い説明ですいません。

【64341】Re:処理が重い
回答  Hirofumi  - 10/1/31(日) 9:13 -

引用なし
パスワード
   試しに、61503行(内20000行がKeyで重複)のデータを作って
Win98、Excel2000にて提示のコードを使って実行しましたが
確かに、処理が非常に遅いのか?、フリーズした状態なのか?
不安定な状態の様でした

其処で、以下のコードを試しに作って見ました
結果は、合って居ると思いますが確認して下さい

尚、データに列見出しは無い物とし、List先頭はA1から始まる物とします
Option Explicit

Public Sub Ver2maedaosi_2()

  'Listのデータ列数(A列〜D列)
  Const clngColumns As Long = 4
  '「計画数」列の在る位置(品番列を0番目と勘定する)
  Const clngItems As Long = 2
  
  Dim i As Long
  Dim j As Long
  Dim lngRows As Long
  Dim rngList As Range
  Dim vntTop As Variant
  Dim vntData As Variant
  Dim vntItems As Variant
  Dim vntKeys As Variant
  Dim vntOrders As Variant
  Dim vntDelete As Variant
  Dim lngStart As Long
  Dim lngCount As Long
  Dim lngMax As Long
  Dim strProm As String

  'Listの先頭セル位置を基準とする(先頭列の列見出しのセル位置)
  Set rngList = Worksheets("展開").Range("A1")
  
  With rngList
    '行数の取得
    lngRows = .Offset(Rows.Count - .Row).End(xlUp).Row - .Row + 1
    If lngRows <= 1 And .Value = "" Then
      strProm = "データが有りません"
      GoTo Wayout
    End If
  End With
  
  '画面更新を停止
  Application.ScreenUpdating = False
  
  '復帰用整列Keyを作成
  With rngList.Offset(, clngColumns)
    .Value = 1
    .Resize(lngRows).DataSeries _
        Rowcol:=xlColumns, Type:=xlLinear, Date:=xlDay, _
        Step:=1, Trend:=False
  End With
  
  '整列Keyを作成(A列順のB列順)
  vntKeys = Array(0, 1)
  '整列順を指定
  lngMax = UBound(vntKeys)
  ReDim vntOrders(lngMax)
  For i = 0 To lngMax
    vntOrders(i) = xlAscending
  Next i
  'データをKeys順に整列
  DataSort rngList.Resize(lngRows, clngColumns + 1), vntKeys, vntOrders
  
  With rngList
    '復帰用整列Keyを取得
    vntDelete = .Offset(, clngColumns).Resize(lngRows + 1).Value
    '「計画数」列の値を配列に取得
    vntItems = .Offset(, clngItems).Resize(lngRows + 1).Value
  End With
  
  'Listの先頭〜最終まで繰り返し
  lngStart = 0
  vntTop = rngList.Offset(lngStart).Resize(, clngColumns).Value
  For i = 1 To lngRows
    'Listから1レコード分取得
    vntData = rngList.Offset(i).Resize(, clngColumns).Value
    '配列の先頭から最終まで比較
    For j = 0 To lngMax
      If vntTop(1, vntKeys(j) + 1) <> vntData(1, vntKeys(j) + 1) Then
        Exit For
      End If
    Next j
    '前列一致した場合
    If j > lngMax Then
      '「計画数」列の集計
      vntItems(lngStart + 1, 1) _
          = vntItems(lngStart + 1, 1) + vntData(1, clngItems + 1)
      'Flagを立てる
      vntDelete(i + 1, 1) = Empty
      '削除数を加算
      lngCount = lngCount + 1
    Else
      '同値先頭位置を更新
      lngStart = i
      '配列の中身を入れ替え
      vntTop = vntData
    End If
  Next i
    
  With rngList
    '「計画数」列の集計を出力
    .Offset(, clngItems).Resize(lngRows).Value = vntItems
    'Flagを最終列に出力
    .Offset(, clngColumns).Resize(lngRows).Value = vntDelete
    '削除行を最終行に集める為、Flag列をKeyとして整列
    DataSort .Resize(lngRows, clngColumns + 1), _
                 Array(clngColumns), Array(xlAscending)
    '削除行が有るなら
    If lngCount > 0 Then
      '削除行を削除
      .Offset(lngRows - lngCount).Resize(lngCount).EntireRow.Delete
      strProm = lngCount & "件の削除が実行されました"
    Else
      strProm = "該当行が無い為、削除は行われませんでした"
    End If
    '削除Flag列を削除
    .Offset(, clngColumns).EntireColumn.Delete
    '列幅の調整
    .Parent.Columns.AutoFit
  End With
  
Wayout:

  '画面更新を再開
  Application.ScreenUpdating = True
  
  Set rngList = Nothing
   
'  Sheets("メニュー画面").Select 'メニュー画面を選ぶ
   
  MsgBox strProm , vbInformation
          
End Sub

Private Sub DataSort(rngScope As Range, _
          vntKeys As Variant, _
          vntOrders As Variant)
  
  Dim i As Long
  Dim j As Long
  Dim vntK As Variant
  Dim vntO As Variant
  Dim lngNum As Long
  
  vntK = vntKeys
  vntO = vntOrders
  
  lngNum = -Int(-(UBound(vntK) + 1) / 3) * 3 - 1
  
  ReDim Preserve vntK(lngNum), vntO(lngNum)
  For i = UBound(vntOrders) + 1 To lngNum
    vntO(i) = xlAscending
  Next i
  
  With rngScope
    For i = lngNum To 0 Step -3
      .Sort _
        Key1:=.Cells(1, vntK(i - 2) + 1), _
        Key2:=IIf(IsEmpty(vntK(i - 1)), vntK(i - 1), .Cells(1, vntK(i - 1) + 1)), _
        Key3:=IIf(IsEmpty(vntK(i)), vntK(i), .Cells(1, vntK(i) + 1)), _
        Order1:=vntO(i - 2), _
        Order2:=vntO(i - 1), _
        Order3:=vntO(i), _
        Header:=xlNo, OrderCustom:=1, MatchCase:=False, _
        Orientation:=xlTopToBottom, SortMethod:=xlStroke
    Next i
  End With
  
End Sub

【64344】Re:処理が重い
発言  Hirofumi  - 10/1/31(日) 9:44 -

引用なし
パスワード
   あ!、コメントが間違えていました

  'Listの先頭セル位置を基準とする(先頭列の列見出しのセル位置)
  Set rngList = Worksheets("展開").Range("A1")
  
と成っていますが

  'Listのデータ先頭セル位置を基準とする
  Set rngList = Worksheets("展開").Range("A1")
  
の間違いです

【64372】Re:処理が重い
発言  よろずや  - 10/1/31(日) 20:55 -

引用なし
パスワード
   適材適所

この処理にエクセルは向いていません。
データベースソフトの導入を検討しましょう。

【64376】Re:処理が重い
お礼  tetu  - 10/1/31(日) 23:18 -

引用なし
パスワード
   ▼かみちゃん さん:
>こんにちは。かみちゃん です。
>
>>ExcelにてCSVファイルを取込で計画数を処理するマクロをくんでいます
>>65536行ふるに使うとどうしても処理が固まり動かなくなります
>>どのようにしたらいいかわかるかたおしえてください。
>
>処理をする際に、開いているブックのすべてのシートにどれくらい数式が入っていますか?
>再計算を手動にして、実行するとどうなりますか?
>
>あと、コード全体をきちんと見ていませんが、
>Selectしないコード、配列を使う、65536行もデータがあるならば、データベースソフトも併用するなどの方法が
>考えられます。


再計算を手動にすると、関数部分は、マクロ処理の時最終的に削除してしまうため
どうしようもないです。
データベースソフトも考えていますが勉強不足で現状正直扱い切れません。
アドバイスいただきありがとうございました。

【64377】Re:処理が重い
質問  tetu  - 10/1/31(日) 23:27 -

引用なし
パスワード
   ▼Hirofumi さん:
>あ!、コメントが間違えていました
>
>  'Listの先頭セル位置を基準とする(先頭列の列見出しのセル位置)
>  Set rngList = Worksheets("展開").Range("A1")
>  
>と成っていますが
>
>  'Listのデータ先頭セル位置を基準とする
>  Set rngList = Worksheets("展開").Range("A1")
>  
>の間違いです


そのまま併用してテストしてみましたが、かなり速いです
しかし現状65536行まで今は、満たすデータが手元に無く
しっかり試したわけでわないです。
1.再度質問したいのですがこれは、行数が、追加されてもこの速さ維持できますか??。
2.素人に近い私ですので、この構文が理解できない部分がかなりあります。
どういう流れの処理か簡潔に教えていただけないでしょうか?
3.もしこのままの速さで維持できるならばこのまま使わせていただきたいのですが・・・?
よろしくお願いいたします。

【64378】Re:処理が重い
お礼  tetu  - 10/1/31(日) 23:29 -

引用なし
パスワード
   ▼よろずや さん:
>適材適所
>
>この処理にエクセルは向いていません。
>データベースソフトの導入を検討しましょう。


データベースソフトは、これから勉強して使えるようにしていきたいと
思いますアドバイスありがとうございました。

【64379】Re:処理が重い
回答  Hirofumi  - 10/2/1(月) 8:03 -

引用なし
パスワード
   >そのまま併用してテストしてみましたが、かなり速いです
>しかし現状65536行まで今は、満たすデータが手元に無く
>しっかり試したわけでわないです。

先ず元々のコードの確認をして置きます
元のコードでは、品番と納期をKeyとして、このKeyが等しい行が合った場合
その行の計画数を合計して、Key重複の行を削除すると言う動作ですね?
一応、当方のコードは、この様に組んだつもりです
ただ、実際のデータで試して居ないので、結果が希望通りに出て居るのかを良く検証して下さい
また、このコードは、シート最終行から上にデータ最終行を探しているので
原理上、扱えるデータの最大行は65535行に成りますので宜しく

>1.再度質問したいのですがこれは、行数が、追加されてもこの速さ維持できますか??。

此れに就いてはどう言う意味なのか解りませんが?
先ず、元のコードに就いて言うと、最後の方で
「オートフィルターで空白以外のセルを絞り込む」の後、抽出された行をCopy、Pasteして居ます
この時、データ行数が多い場合Excelがエラーを出している様です(連続しない範囲が8192?箇所を超える)
此れが、フリーズした様に見える若しくはしている様です
実際、Testデータとして、61503行(内Keyに就いての重複20000行)のデータを用意して
Win98、Excel2000、メモリ256Mで実行した場合はフリーズ
Vista、Excel2007、メモリ2Gで実行した場合も1時間たっても終了しないので実行中止の状態でした
また、当方のコードで同じデータでTestした結果は
Win98、Excel2000、メモリ256Mで実行した場合は、10秒〜16秒程度で完了している様です
Vista、Excel2007の場合、2秒弱?

>2.素人に近い私ですので、この構文が理解できない部分がかなりあります。
>どういう流れの処理か簡潔に教えていただけないでしょうか?

フローは、
1、データの行数を取得
2、データ最終列の後ろの列(E列)に先頭〜最終行までの連番を振ります
3、データを品番順の納期順で整列します
4、データを上から見て行って、前の行と品番が等しく且つの納期が等しい場合
 計画数を、品番、納期の同値先頭行に加算て行きます
 同時に、同値の場合、2で振った連番を消し(削除する印を付ける)、
 削除する行数をカウントします
 ただ、連番の消去は直接セルに対して行わず、配列上で行ってLoop後にE列に再出力を行います
5、この作業が終わった所で、連番列(E列)をKeyとして全体を整列します
6、整列すると、連番を消去して行はデータの下に集まります
7、データ行の後ろから、カウントした削除行数分行削除を行います
以上

>3.もしこのままの速さで維持できるならばこのまま使わせていただきたいのですが・・・?
結果が合うなら、使って下さい(コード理解する努力も行って下さい)


後、B列の日付の書式設定を忘れていましたので以下の★印を追加して下さい

    '列幅の調整
    .Parent.Columns.AutoFit
    'B列の書式設定
    .Offset(, 1).Resize(lngRows).NumberFormat = "yyyy/m/d" '★追加
  End With
  
Wayout:

【64380】Re:処理が重い
発言  Jaka  - 10/2/1(月) 9:19 -

引用なし
パスワード
   ほんのちょっとだけ見ただけですけど、
削除するときに、再計算を手動にしてますか?
しているようだったらすみません。

【64411】Re:処理が重い
質問  tetu  - 10/2/4(木) 1:56 -

引用なし
パスワード
   ▼Hirofumi さん:
>>そのまま併用してテストしてみましたが、かなり速いです
>>しかし現状65536行まで今は、満たすデータが手元に無く
>>しっかり試したわけでわないです。
>
>先ず元々のコードの確認をして置きます
>元のコードでは、品番と納期をKeyとして、このKeyが等しい行が合った場合
>その行の計画数を合計して、Key重複の行を削除すると言う動作ですね?
>一応、当方のコードは、この様に組んだつもりです
>ただ、実際のデータで試して居ないので、結果が希望通りに出て居るのかを良く検証して下さい
>また、このコードは、シート最終行から上にデータ最終行を探しているので
>原理上、扱えるデータの最大行は65535行に成りますので宜しく
>
>>1.再度質問したいのですがこれは、行数が、追加されてもこの速さ維持できますか??。
>
>此れに就いてはどう言う意味なのか解りませんが?
>先ず、元のコードに就いて言うと、最後の方で
>「オートフィルターで空白以外のセルを絞り込む」の後、抽出された行をCopy、Pasteして居ます
>この時、データ行数が多い場合Excelがエラーを出している様です(連続しない範囲が8192?箇所を超える)
>此れが、フリーズした様に見える若しくはしている様です
>実際、Testデータとして、61503行(内Keyに就いての重複20000行)のデータを用意して
>Win98、Excel2000、メモリ256Mで実行した場合はフリーズ
>Vista、Excel2007、メモリ2Gで実行した場合も1時間たっても終了しないので実行中止の状態でした
>また、当方のコードで同じデータでTestした結果は
>Win98、Excel2000、メモリ256Mで実行した場合は、10秒〜16秒程度で完了している様です
>Vista、Excel2007の場合、2秒弱?
>
>>2.素人に近い私ですので、この構文が理解できない部分がかなりあります。
>>どういう流れの処理か簡潔に教えていただけないでしょうか?
>
>フローは、
>1、データの行数を取得
>2、データ最終列の後ろの列(E列)に先頭〜最終行までの連番を振ります
>3、データを品番順の納期順で整列します
>4、データを上から見て行って、前の行と品番が等しく且つの納期が等しい場合
> 計画数を、品番、納期の同値先頭行に加算て行きます
> 同時に、同値の場合、2で振った連番を消し(削除する印を付ける)、
> 削除する行数をカウントします
> ただ、連番の消去は直接セルに対して行わず、配列上で行ってLoop後にE列に再出力を行います
>5、この作業が終わった所で、連番列(E列)をKeyとして全体を整列します
>6、整列すると、連番を消去して行はデータの下に集まります
>7、データ行の後ろから、カウントした削除行数分行削除を行います
>以上
>
>>3.もしこのままの速さで維持できるならばこのまま使わせていただきたいのですが・・・?
>結果が合うなら、使って下さい(コード理解する努力も行って下さい)
>
>
>後、B列の日付の書式設定を忘れていましたので以下の★印を追加して下さい
>
>    '列幅の調整
>    .Parent.Columns.AutoFit
>    'B列の書式設定
>    .Offset(, 1).Resize(lngRows).NumberFormat = "yyyy/m/d" '★追加
>  End With
>  
>Wayout:


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


1.lngRows = .Offset(Rows.Count - .Row).End(xlUp).Row - .Row + 1

A列のデータ範囲を示しているのはなんとなくわかるのですが少しわからないです?
たとえば1000行データがある場合1000行-1-999-2=997行のデータ範囲という事でしょうか???

2. DataSort rngList.Resize(lngRows, clngColumns + 1), vntKeys, vntOrders


データ範囲を並べ替えしているコードみたいですが、後のvntkeysとvntOrdersのところで
vntKeysが二次元配列の変数が格納vntOrders動的配列の変数のようですが、考えてもわからず
?です


3.
If vntTop(1, vntKeys(j) + 1) <> vntData(1, vntKeys(j) + 1) Then

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

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

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列)
の値も一緒ではないと合計をしない形におもえています。
ロット番号も同じデータはなく品番納期のみダブります。
その部分の計画数を合計した形にしたいのですが・・・・・?

【64412】Re:処理が重い
お礼  tetu  - 10/2/4(木) 2:00 -

引用なし
パスワード
   ▼Jaka さん:
>ほんのちょっとだけ見ただけですけど、
>削除するときに、再計算を手動にしてますか?
>しているようだったらすみません。


手動にしていません
してしまうと正しい処理がされなくなります。

【64413】Re:処理が重い
発言  かみちゃん E-MAIL  - 10/2/4(木) 6:25 -

引用なし
パスワード
   こんにちは。かみちゃん です。

>>削除するときに、再計算を手動にしてますか?
>>しているようだったらすみません。
>
>
>手動にしていません
>してしまうと正しい処理がされなくなります。

マクロ実行時に再計算を手動にしておき、処理終了時に、自動に戻すか、再計算を
実行すれば?
という意味なのですが、途中で処理結果が正しくならなければいけないのでしょうか?

【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

【64470】Re:処理が重い
お礼  tetu  - 10/2/11(木) 0:23 -

引用なし
パスワード
   ▼かみちゃん さん:
>こんにちは。かみちゃん です。
>
>>>削除するときに、再計算を手動にしてますか?
>>>しているようだったらすみません。
>>
>>
>>手動にしていません
>>してしまうと正しい処理がされなくなります。
>
>マクロ実行時に再計算を手動にしておき、処理終了時に、自動に戻すか、再計算を
>実行すれば?
>という意味なのですが、途中で処理結果が正しくならなければいけないのでしょうか?

処理終了後に自動に戻して再計算設定しても計算した部分を最終的にマクロ実行で削除してしまうので
結果が出せないという事です。

【64471】Re:処理が重い
質問  tetu  - 10/2/11(木) 1:12 -

引用なし
パスワード
   返事遅れてすいません構文が難しく悩んでいて八方ふさがりになっていました。
とりあえず処理自体は希望どうりの動きと結果でした。
自分も勘違いしていた部分もあり理解した部分もあるのですが理解できない
部分は、いまだにインターネット又本等で調べているのですがわからず
あつかましのですがもう一度教えてください

vntKeys = Array(0, 1) 


カンマがついていたので2次元配列と勘違いしていました。
Array関数は1次元配列のバリアント型なのは納得しましたが、Arrayで列を格納する場合
Array(”A”、”B”、”C”、”D”)又は数字の場合Array(Array(0,1)・・・・
見たいな感じかとおもっていました?
上記文だと
Vntkeys(0)=0’VntKeys(0)に0を格納する
vntKeys(1)=1’VntKeys(1)に1を格納する
と自分は解釈していまあしたが、これで2列をキーとできるのがとても不思議です?
後Private Subの構文も処理がわからず

特に
lngNum = -Int(-(UBound(vntK) + 1) / 3) * 3 - 1 ’///この構文がわからない?
  
  ReDim Preserve vntK(lngNum), vntO(lngNum)
  For i = UBound(vntOrders) + 1 To lngNum ’動的配列宣言範囲VntOrdersに1                        ’を足した数字〜lngNumまで
    vntO(i) = xlAscending ’vnt0で繰り返し参照している部分を昇順にする
  Next i iに処理を移行
  
  With rngScope rngScopeに対して同じ処理を行う
    For i = lngNum To 0 Step -3 ’///なんでステップ3ずつ?
      .Sort _
        Key1:=.Cells(1, vntK(i - 2) + 1), _
        Key2:=IIf(IsEmpty(vntK(i - 1)), vntK(i - 1), .Cells(1, vntK(i - 1) + 1)), _
        Key3:=IIf(IsEmpty(vntK(i)), vntK(i), .Cells(1, vntK(i) + 1)), _
        Order1:=vntO(i - 2), _
        Order2:=vntO(i - 1), _
        Order3:=vntO(i), _
        Header:=xlNo, OrderCustom:=1, MatchCase:=False, _
        Orientation:=xlTopToBottom, SortMethod:=xlStroke
後上記配列を使用しないコードを処理してみましたがこちらも処理結果はOKですが
ステップごとに動かして見ましたがE列に連番を振っている部分は確認できましたが
その後は処理が早すぎるため動きが確認できませんでした。
一応報告まで

【64473】Re:処理が重い
回答  Hirofumi  - 10/2/11(木) 9:49 -

引用なし
パスワード
   >  返事遅れてすいません構文が難しく悩んでいて八方ふさがりになっていました。
>とりあえず処理自体は希望どうりの動きと結果でした。
>自分も勘違いしていた部分もあり理解した部分もあるのですが理解できない
>部分は、いまだにインターネット又本等で調べているのですがわからず
>あつかましのですがもう一度教えてください

私も説明が下手で恐縮している所ですが、
解らなければ、遠慮しないで何度でも聞いて下さい

先ず、くどく成って申し訳ありませんが?
今回のコードのに就いて

目的:Listの中の、各行(レコード)でKeyが重複する場合
 その行の或るフィールドの値を、Key重複する先頭行のフィールドに集計し
 Key重複する先頭行以外は、行削除する

条件:ListはA1を左隅とし、列数はA〜D列の4列、データ行数は実行する毎に違う
 Keyと成るのは、A列(品番)、B列(納期)の2Keyで、
 集計するのは、C列(計画数)とする

此れを目的、条件をガチガチに守って組んだコードが「Sub Ver2maedaosi_4」です
 しかし、もし目的その物は変わらないが、対象と成るListの位置を変えなければ成らない
Keyの位置が変わった、Keyの数が変わった等の変更
 または、同じ目的なので、違うListに使い回したい等の場合
 例えば、List先頭がB2から始まり、列数がB〜F列の5列、KeyがB列、C列、E列の3列と成り
集計列が、F列とした場合
「Sub Ver2maedaosi_4」では、コードの中身を大幅に変更しなければ成りません
しかし、「Sub Ver2maedaosi_2」では

  'Listのデータ列数(B列〜F列)
  Const clngColumns As Long = 5
  '「計画数」列の在る位置(品番列を0番目と勘定する)
  Const clngItems As Long = 4

  'Listのデータ先頭セル位置を基準とする
  Set rngList = Worksheets("展開").Range("B2")

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

と4箇所の値を変更すれば済みます
それ故、コードが回りくどく成っている事をお詫びして置きます

さて、

>vntKeys = Array(0, 1) 
>
>カンマがついていたので2次元配列と勘違いしていました。
>Array関数は1次元配列のバリアント型なのは納得しましたが、Arrayで列を格納する場合
>Array(”A”、”B”、”C”、”D”)又は数字の場合Array(Array(0,1)・・・・
>見たいな感じかとおもっていました?
>上記文だと
>Vntkeys(0)=0’VntKeys(0)に0を格納する
>vntKeys(1)=1’VntKeys(1)に1を格納する
>と自分は解釈していまあしたが、これで2列をキーとできるのがとても不思議です?

「vntKeys = Array(0, 1)」の理解は、上記で合って居ます
詰まり、vntKeys(0)=0、vntKeys(1)=1の意味でしか有りません
しかし、これがなぜKeyの位置を示すかと言うと
別のプロシージャ等で行われているので、直接は書いて有りませんが
以下の様な使われ方がされています(意味として)

 rngList.Offset(0, vntKeys(0)):rngList.Offset(0, 0)と成り、
                rngListがA1なら、A列を示します
 rngList.Offset(0, vntKeys(1)):rngList.Offset(0, 1)と成り、
                同様に、B列を示します

>後Private Subの構文も処理がわからず
>
>特に
>lngNum = -Int(-(UBound(vntK) + 1) / 3) * 3 - 1 ’///この構文がわからない?

「-Int(-実数)」と言う構文は、切り上げ計算をするのBasicの定石です
行っている意味は、vntK(基底0の配列)を後で出てくるSortメソッドの為に
vntKの要素数を超える最小の3の倍数の要素数にvntKの要素数を拡張する為の
数を出して居ます

UBound(vntK) + 1:配列vntKの要素上限(基底0なので要素数は+1)から要素数を出している
例えば、Keyが2個なら、UBound(vntK)の要素上限は1、要素数は2
因って、

lngNum = -Int(-2 / 3) * 3 - 1:2/3は、0.666・・と成るので切り上げて1、
               1*3で3、-1するのでlngNumは2と成ります
               後で、配列vntKを拡張しますので、
               配列vntKは、要素0〜2の3要素数と成ります
また、Keyが1個の場合、「UBound(vntK) + 1」は1と成り、0.33・を切り上げ1、
1*3-1で、配列vntKは、要素0〜2の3要素数と成ります
同様に、Keyが3個の場合、「UBound(vntK) + 1」は3と成り、3/3で1、
1*3-1で、配列vntKは、要素0〜2の3要素数と成ります

此れは、コードの都合上、形だけ常に3Keyで整列するコードにしている為に
行って居ます
Range.Sortのメソッドは、引数Key2:、Key3:にEmptyを与えた場合Keyを無視する様です
ただこの時、無視させる場合でもOrder2:、Order3:にはxlAscending(1)xlDescending(2)を
入れなければ成らない様です

>  
>  ReDim Preserve vntK(lngNum), vntO(lngNum)
>  For i = UBound(vntOrders) + 1 To lngNum ’動的配列宣言範囲VntOrdersに1’を足した数字〜lngNumまで
>    vntO(i) = xlAscending ’vnt0で繰り返し参照している部分を昇順にする
>  Next i iに処理を移行

上記で説明した様に
配列vntK、配列vntOを値を保持したまま、要素数を3の倍数に拡張し
配列vntOは、拡張した分にxlAscending詰まり1を代入しています
  
>  With rngScope rngScopeに対して同じ処理を行う
>    For i = lngNum To 0 Step -3 ’///なんでステップ3ずつ?
>      .Sort _
>        Key1:=.Cells(1, vntK(i - 2) + 1), _
>        Key2:=IIf(IsEmpty(vntK(i - 1)), vntK(i - 1), .Cells(1, vntK(i - 1) + 1)), _
>        Key3:=IIf(IsEmpty(vntK(i)), vntK(i), .Cells(1, vntK(i) + 1)), _
>        Order1:=vntO(i - 2), _
>        Order2:=vntO(i - 1), _
>        Order3:=vntO(i), _
>        Header:=xlNo, OrderCustom:=1, MatchCase:=False, _
>        Orientation:=xlTopToBottom, SortMethod:=xlStroke

Range.Sortのメソッドの引数Key1:、Key2:、Key3:と引数Order1:、Order2:、Order3:に
配列vntK、 vntOの値を後ろから3個づつ与えてSortします
(この時、Keyは無視させる場合Emptyを、実行させる場合は、Rangeに直して与える)
尚、「vntKeys = Array(0, 1)」で与えるKey数が3個以内なら1回整列が行われ
「vntKeys = Array(0, 1, 2, 3)」と4Keyなら、「3」列で1回、「0, 1, 2」列で1回の
2回整列が行われます

>後上記配列を使用しないコードを処理してみましたがこちらも処理結果はOKですが
>ステップごとに動かして見ましたがE列に連番を振っている部分は確認できましたが
>その後は処理が早すぎるため動きが確認できませんでした。
>一応報告まで

先ず、

  '画面更新を停止
  Application.ScreenUpdating = False

をコメントアウトして下さい(画面更新をする様にして置く)
次に、1行実行(F8キーで進める)したら「Worksheets("展開")」を見て下さい
書き込まれるセルの値が変更されている筈です
尚、Testは20〜30行位のテストデータの方が解りやすいかと思います

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