|
おはよう御座います。
今回は検索条件に合ったものを行ごと削除してC列でソートを掛けるという
事をしております。
前回(39281)でJakaさんに教えていただいた
物に自分なりにいろいろとやってみまして機能していますが
データー数が10000件を超えてしまう為、処理の時間が
かかってしまいます。
現在テストで検索条件2900行 検索範囲5250行でやっていますが
約6分ほど掛かります。他にいい方法かヒントになるレスを教えてください。
対象マスターのシートのAには重複はありません。
A B C ・・・・・J
1 Jコード (空白です) 分類コード Tコード
2
3
4
5
発注商品のシートのA列には重複はありません
A B C
1 Jコード 品名 Tコード
2
3
4
5
というようなシートで以下のように書いています。
Sub Test()
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です。
|
|