Excel VBA質問箱 IV

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

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


	新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃過去ログ ┃ホーム

9097 / 76737

←次へ　｜　前へ→


	【73206】VBAはじめてです。

うどん - 12/11/30(金) 4:46 -


	引用なし

	パスワード

処理遅くて困っています。
何か書き方がまずいのでしょうか？
よろしくお願いいたします。ｍ（＿＿）ｍ

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

0 hits

▼

【73206】VBAはじめてです。 うどん 12/11/30(金) 4:46

≪