| 
    
     |  | 処理遅くて困っています。 何か書き方がまずいのでしょうか?
 よろしくお願いいたします。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
 
 |  |