ループなしループVBA

Question

VBAが新しくなった。以下は、列Bで選択された別の検証リストのオプションに応じて、列Cのセルに検証リストを適用するコードです。それはclunkyと遅いです。私はそれを書くために別の方法でいくつかのアイデアを期待していた。ここに私が持っているものがあります：

For k = 36 To 88 

    If Range("B" & k) Is Nothing Then 
    Else 
     CarrierName = Range("B" & k) 
     Range("C" & k).Name = "PlanName" 
     xPlanDropDown = PlanDropDown(CarrierName, PlanName) 
    End If 

    Next k 

End Sub 

Function PlanDropDown(CarrierName, PlanName) 

    Select Case CarrierName 

     Case "Aetna EPO" 
       Range("PlanName").Validation _ 
       .Modify xlValidateList, xlValidAlertStop, Formula1:="=Plans!A2:A101" 
     Case "Aetna HMO" 
       Range("PlanName").Validation _ 
       .Modify xlValidateList, xlValidAlertStop, Formula1:="=Plans!B2:B101" 
     Case "Aetna PPO" 
       Range("PlanName").Validation _ 
       .Modify xlValidateList, xlValidAlertStop, Formula1:="=Plans!C2:C101" ... 

あなたが提供できる何かお手伝いをありがとうございます！シェリル

Answer 1

ようこそ！

これほど多くの回答はありませんが、これはあなたのVBAをかなりスピードアップするはずです。これは、他のすべてのVBAルーチンを呼び出すFIRSTサブルーチンに入ります。たとえば、あなたが参照したFUNCTIONに入れないでください。

あなたSUBの先頭にこれを追加します。

Dim PrevCalc As XlCalculation 
With Application 
    PrevCalc = .Calculation 
    .Calculation = xlCalculationManual 
    .Cursor = xlWait 
    .Calculate 
    .EnableEvents = False 
    .DisplayAlerts = False 
    '.ScreenUpdating = False ' Not really needed 
End With 

その後、下にこれを追加します。

With Application 
    .Cursor = xlDefault 
    .Calculate 
    .Calculation = PrevCalc 
    '.ScreenUpdating = True 'Not really needed 
    .DisplayAlerts = True 
    .EnableEvents = True 
End With