| |
おはよう御座います。
今回は検索条件に合ったものを行ごと削除してＣ列でソートを掛けるという
事をしております。
前回（３９２８１）でJakaさんに教えていただいた
物に自分なりにいろいろとやってみまして機能していますが
データー数が１００００件を超えてしまう為、処理の時間が
かかってしまいます。
現在テストで検索条件２９００行 検索範囲５２５０行でやっていますが
約６分ほど掛かります。他にいい方法かヒントになるレスを教えてください。
対象マスターのシートのＡには重複はありません。
Ａ Ｂ Ｃ ・・・・・Ｊ
１ Ｊコード （空白です） 分類コード Ｔコード
２
３
４
５
発注商品のシートのＡ列には重複はありません
Ａ Ｂ Ｃ
１ Ｊコード 品名 Ｔコード
２
３
４
５
というようなシートで以下のように書いています。
Sub Ｔest()
Sheets("対象マスター").Select
Rows("1:1").Select
Selection.Insert Shift:=xlDown
Dim SachRag As Range, FilTRg As Range, Cel As Range, Chek As Variant
With Sheets("発注商品")
Set SachRag = .Range(.Range("A2"), .Range("A65536").End(xlUp))
End With
With Sheets("対象マスター")
Set FilTRg = .Range(.Range("A2"), .Range("A65536").End(xlUp))
End With
Application.ScreenUpdating = False
For Each Cel In SachRag
Chek = Application.Match(Cel.Value, FilTRg, 0)
If Not IsError(Chek) Then
FilTRg.AutoFilter Field:=1, Criteria1:=Cel.Value
FilTRg.Offset(1).Resize(FilTRg.Count - 1).SpecialCells(xlCellTypeVisible).EntireRow.Delete Shift:=xlUp
Sheets("対象マスター").ShowAllData
DoEvents
End If
Next
Sheets("対象マスター").AutoFilterMode = False
Sheets("対象マスター").Select
Rows("1:1").Select
Selection.Delete Shift:=xlUp
Range("C1").Select
ActiveCell.FormulaR1C1 = "0000"
Selection.Sort Key1:=Range("C2"), Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, SortMethod _
:=xlPinYin, DataOption1:=xlSortTextAsNumbers
Range("C1").Select
ActiveCell.FormulaR1C1 = "分類コード"
Application.ScreenUpdating = True
End Sub
Jakaさんのをそのままですので恥ずかしいのですが・・・
何かヒントがありましたらお願いします。
環境は XPホーム EXCEL2003 メモリーは512MB プロフェサーは
x86 Family 6 Model 13 Stepping 8 GenuineIntel "1496 Mhzです。
|
|
勉強中です
- 06/6/24(土) 10:34 -
