|
処理遅くて困っています。
何か書き方がまずいのでしょうか?
よろしくお願いいたします。m(__)m
Private Sub Worksheet_Change(ByVal Target As Range)
Columns("A:A").ColumnWidth = 15
Columns("B:B").ColumnWidth = 15
Columns("C:C").ColumnWidth = 5
Columns("D:D").ColumnWidth = 50
Columns("E:E").ColumnWidth = 5
Columns("F:F").ColumnWidth = 5
Columns("G:G").ColumnWidth = 5
Columns("H:H").ColumnWidth = 5
Dim barcord_gyou As Variant, case_count As Variant, factory_name As Variant
Dim found_gyou As Variant, hinmei_input_gyou As Variant, find_kensaku_gyou As Variant
Dim active_cell_now As Variant, find_kensaku_list_gyou As Variant
barcord_gyou = 1
case_count = 2
factory_name = 3
found_gyou = 4
hinmei_input_gyou = 3
find_kensaku_list_gyou = 10
Range("A1:H20000").Font.ColorIndex = 5
If Intersect(Target, Range("B1:B20000")) Is Nothing Then
Exit Sub
Else
If Selection.Cells.Count = 1 Then
Cells(Selection.Row, Selection.Column + case_count) = _
WorksheetFunction.CountIf(ActiveSheet.Range("B1:B20000"), _
Cells(Selection.Row, Selection.Column + barcord_gyou))
' Cells(Selection.Row, Selection.Column + factory_name) = "旧↓"
active_cell_now = Cells(Selection.Row, Selection.Column + 1).Value
With Worksheets("1")
Set find_kensaku_gyou = .Range("I2:I300").Find(active_cell_now)
If find_kensaku_gyou Is Nothing Then
Else
' Cells(Selection.Row, Selection.Column + found_gyou) _
= find_kensaku_gyou.Row
Cells(Selection.Row, Selection.Column + hinmei_input_gyou) _
= Cells(find_kensaku_gyou.Row, find_kensaku_list_gyou)
End If
End With
End If
End If
End Sub
|
|