Excel VBA質問箱 IV

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

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


1604 / 13646 ツリー ←次へ | 前へ→

【73206】VBAはじめてです。 うどん 12/11/30(金) 4:46 質問[未読]
【73207】Re:VBAはじめてです。 UO3 12/11/30(金) 6:47 発言[未読]
【73213】Re:VBAはじめてです。 うどん 12/12/1(土) 4:42 お礼[未読]
【73208】Re:VBAはじめてです。 UO3 12/11/30(金) 10:51 発言[未読]
【73214】Re:VBAはじめてです。 うどん 12/12/1(土) 4:44 お礼[未読]
【73209】Re:VBAはじめてです。 UO3 12/11/30(金) 13:59 発言[未読]
【73215】Re:VBAはじめてです。 うどん 12/12/1(土) 4:45 お礼[未読]

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

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

【73207】Re:VBAはじめてです。
発言  UO3  - 12/11/30(金) 6:47 -

引用なし
パスワード
   ▼うどん さん:

おはようございます

いくつかありますが、おそらく、一番足をひっぱっているのは
「Changeイベントの連鎖」でしょうね。
セルが変更される --> このプロシジャが動く --> プロシジャの中で、セルを変更する
--> その変更により、その変更の瞬間に、またこのイベントが発生して、このプロシジャに
「再入」してくる。こんな流れですね。

現在のコードの制御の構えでいえば

Else
    If Selection.Cells.Count = 1 Then

この Else と If の間に Application.EnableEvents = False

で、最後の

     End If
  End If

この2行の「間」に Application.EnableEvents = True

こうして試してみてください。

さらにいえば、

Columns("A:A").ColumnWidth = 15 等や Range("A1:H20000").Font.ColorIndex = 5 は
必ず実行するようですので、マクロで処理せず、一度、シート上の操作で行っておけば
よろしいかと思います。

【73208】Re:VBAはじめてです。
発言  UO3  - 12/11/30(金) 10:51 -

引用なし
パスワード
   ▼うどん さん:

こんにちは

直接の原因は上で申し上げたようなことでしょうがいくつか気になる点がありますので
老婆心かもしれませんが。

・変数をすべて Variant型で宣言しておられます。これぐらいの処理ですから効率としてどうこういう
 ものではありませんが、数値は Long型、セルは Range型で宣言しておいたほうが、効率もよろしいですし
 また、コードを見たときのわかりやすさも向上すると思います。

・コードの中で Target 以外に Selection を使っておられますね。何か意図はあるのでしょうか?
 たとえば、まず、セル領域を選択しておいて、そのなかを(選択を保ったまま)カーソルを動かし
 どこかのセルに入力する。Targetは、入力されたセル、Selectionは、選択されているセル領域。
 そんな制御を意図しておられるのですか?
 もし、そうでなければ、(変更セル数が1つの時のみ処理対象にしておられますので)
 すべて Target で記述されたほうがわかりやすいですね。

・コードの中で "B1:B20000" や "I2:I300" と、領域の最後を固定にした記述をされていますね。
 この固定領域に意味があるなら、それでよろしいのですが、もしかして B列のデータ最終セルまでとか
 I列のデータ最終セルまでということなら、別途、その場所を動的に取得する書き方のほうが、
 データの増減(特に、増)があったときもコードを書きなおさずに済むので、おすすめです。

・これも、この程度の処理ですから、あまり違いはでませんが、Find は検索系の処理の中でも
 「もっとも重い」処理の1つです。検索が1回だけですのでワークシート関数の Match のほうが、軽いと思いますね。

・あと、転記先セル = 転記元セル という書き方をしておられますね。
 これでも、そのセルの Value が対象になりますが、わかりやすさということであれば
 転記先セル.Value = 転記元セル.Value という記述がよろしいかと。

【73209】Re:VBAはじめてです。
発言  UO3  - 12/11/30(金) 13:59 -

引用なし
パスワード
   ▼うどん さん:

こんにちは

コード全体が正しいかどうかはわかりませんが、アップされたコードでやっておられる(と、思われる)ことを
少し整理してみました。ご参考まで。

なお、

Target.Offset(, hinmei_input_gyou).Value = .Cells(find_kensaku_gyou + 1, "I").Value

勝手に、I列から転記しています。
オリジナルコードを尊重すれば

Target.Offset(, hinmei_input_gyou).Value = .Cells(find_kensaku_gyou + 1, find_kensaku_list_gy).Value

こうなるところですが。

Private Sub Worksheet_Change(ByVal Target As Range)

Dim barcord_gyou As Long
Dim case_count As Long
Dim hinmei_input_gyou As Long
Dim find_kensaku_list_gyou
Dim active_cell_now As Variant
Dim find_kensaku_gyou As Variant

  barcord_gyou = 1
  case_count = 2
  hinmei_input_gyou = 3
  find_kensaku_list_gyou = 10

  If Target.Column <> 1 Or Target.Count <> 1 Then Exit Sub
  
  Application.EnableEvents = False
  
  Target.Offset(, case_count).Value = WorksheetFunction.CountIf(Columns("B"), _
                        Target.Offset(, barcord_gyou).Value)
  active_cell_now = Target.Offset(, 1).Value
  
  With Worksheets("1")
    find_kensaku_gyou = Application.Match(active_cell_now, .Range("I2:I300"), 0)
    If IsNumeric(find_kensaku_gyou) Then _
      Target.Offset(, hinmei_input_gyou).Value = .Cells(find_kensaku_gyou + 1, "I").Value
  End With
        
  Application.EnableEvents = False
  
End Sub

【73213】Re:VBAはじめてです。
お礼  うどん  - 12/12/1(土) 4:42 -

引用なし
パスワード
   改善して実行すると驚くべき速さにびっくりしました。(@@;)
奥が深いです。
ありがとうございました。

m(__)m

【73214】Re:VBAはじめてです。
お礼  うどん  - 12/12/1(土) 4:44 -

引用なし
パスワード
   型宣言もやりなおしてみました。
速さにびっくりしました。(@@;)
ありがとうございました。

m(__)m

【73215】Re:VBAはじめてです。
お礼  うどん  - 12/12/1(土) 4:45 -

引用なし
パスワード
   まだ理解不可能な行がありますが
速度にびっくりしました。(@@;)
ありがとうございました。

m(__)m

1604 / 13646 ツリー ←次へ | 前へ→
ページ:  ┃  記事番号:
2610219
(SS)C-BOARD v3.8 is Free