Excelマクロの実行が粉砕され、数式を簡略化しようとしています

Question

Excelマクロにはかなり新しいので、次のマクロがMacとWinの両方のExcelを粉砕している理由はわかりません。したがって、私は数式を簡略化して、多くのifを1つの数式に減らしたいと考えています。助けてもらえますか？

Private Sub Worksheet_Change(ByVal Target As Range) 

Dim KeyCells As Range 
Set KeyCells = Range("B8") 

If Range("B8").Value = "0" Then 
    Rows("14:24").EntireRow.Hidden = True 
    Rows("13").EntireRow.Hidden = False 
    Range("B14:B24").Clear 
    Worksheets("Sheet1").Range("B9").Value = "Open" 
End If 

If Range("B8").Value = "1" Then 
    Rows("15:24").EntireRow.Hidden = True 
    Rows("13:14").EntireRow.Hidden = False 
    Worksheets("Sheet1").Range("B9").Value = "Open" 
    Range("B15:B24").Clear 
End If 

If Range("B8").Value = "2" Then 
    Rows("16:24").EntireRow.Hidden = True 
    Rows("13:15").EntireRow.Hidden = False 
    Worksheets("Sheet1").Range("B9").Value = "Open" 
    Range("B16:B24").Clear 
End If 

If Range("B8").Value = "3" Then 
    Rows("17:24").EntireRow.Hidden = True 
    Rows("13:16").EntireRow.Hidden = False 
    Worksheets("Sheet1").Range("B9").Value = "Open" 
    Range("B17:B24").Clear 
End If 

If Range("B8").Value = "4" Then 
    Rows("18:24").EntireRow.Hidden = True 
    Rows("13:17").EntireRow.Hidden = False 
    Range("B18:B24").Clear 
End If 

If Range("B8").Value = "5" Then 
    Rows("19:24").EntireRow.Hidden = True 
    Rows("13:18").EntireRow.Hidden = False 
    Range("B19:B24").Clear 
End If 

If Range("B8").Value = "6" Then 
    Rows("20:24").EntireRow.Hidden = True 
    Rows("13:19").EntireRow.Hidden = False 
    Range("B20:B24").Clear 
End If 

If Range("B8").Value = "7" Then 
    Rows("21:24").EntireRow.Hidden = True 
    Rows("13:20").EntireRow.Hidden = False 
    Range("B21:B24").Clear 
End If 

If Range("B8").Value = "8" Then 
    Rows("22:24").EntireRow.Hidden = True 
    Rows("13:21").EntireRow.Hidden = False 
    Range("B22:B24").Clear 
End If 

If Range("B8").Value = "9" Then 
    Rows("23:24").EntireRow.Hidden = True 
    Rows("13:22").EntireRow.Hidden = False 
    Range("B23:B24").Clear 
End If 

If Range("B8").Value = "10" Then 
    Rows("24").EntireRow.Hidden = True 
    Rows("13:23").EntireRow.Hidden = False 
    Range("B24").Clear 
End If 

If Range("B8").Value = "11" Then 
    Rows("13:24").EntireRow.Hidden = False 
End If 

End Sub 

あなたが見ることができるように、式のロジックは次のとおりですB8の値が高いほど、13と24の間に以下の行が隠されています。 B8の値が小さいほど、隠れた行の数が多くなり、隠れた行の値がクリアされます。

Answer 1

あなたはまず、あなたが非表示にする行数Range("B8").Valueセットの中の値に応じて（.Hidden = False）見えるように行13-34のセット全体を設定し、後でことができます。

Range（ "B8"）の値が変更された場合にのみこのコードを実行したいので、Worksheet_Changeイベントに行を追加して確認してください：If Not Intersect(Target, Range("B8")) Is Nothing Then。

コード

Private Sub Worksheet_Change(ByVal Target As Range) 

Application.EnableEvents = True 
If Not Intersect(Target, Range("B8")) Is Nothing Then ' <-- run this code only when changing the value of B8 
    Select Case Target.Value 

     Case 0 To 11 
      Range("B13:B24").EntireRow.Hidden = False 
      Range("B" & 14 + Target.Value & ":B24").EntireRow.Hidden = True 
      Range("B" & 14 + Target.Value & ":B24").Clear 
     Case Else 
      'do nothing 

    End Select 
End If 
Application.EnableEvents = True 

End Sub 

Answer 2

コードがワークシートを変更するたびにchangeイベントが再度呼び出されるため、処理が遅くなります。したがって、あなたは再帰的に実行される多くの変更イベントを取得できます。

コード内で元々起こっていたことを確認するには、F8キーを使用してシーケンスを「ステップスルー」できます。マーカーがClearステートメントに達すると、Worksheet_Changeイベントが再度呼び出されます。

元の変更イベントが終了した時刻を、サブルーチン外で宣言された変数で追跡することによって、これを停止できます。

Public booCancelChange As Boolean 

Private Sub Worksheet_Change(ByVal Target As Range) 
Dim KeyCells As Range 
Set KeyCells = Range("B8") 

'Test whether to run 
If Not booCancelChange Then 
    'Stop recursive calls 
    booCancelChange = True 

    If Range("B8").Value = "0" Then 
     Rows("14:24").EntireRow.Hidden = True 
     Rows("13").EntireRow.Hidden = False 
     Range("B14:B24").Clear 
     Worksheets("Sheet1").Range("B9").Value = "Open" 
    End If 

    If Range("B8").Value = "1" Then 
     Rows("15:24").EntireRow.Hidden = True 
     Rows("13:14").EntireRow.Hidden = False 
     Worksheets("Sheet1").Range("B9").Value = "Open" 
     Range("B15:B24").Clear 
    End If 

    If Range("B8").Value = "2" Then 
     Rows("16:24").EntireRow.Hidden = True 
     Rows("13:15").EntireRow.Hidden = False 
     Worksheets("Sheet1").Range("B9").Value = "Open" 
     Range("B16:B24").Clear 
    End If 

    If Range("B8").Value = "3" Then 
     Rows("17:24").EntireRow.Hidden = True 
     Rows("13:16").EntireRow.Hidden = False 
     Worksheets("Sheet1").Range("B9").Value = "Open" 
     Range("B17:B24").Clear 
    End If 

    If Range("B8").Value = "4" Then 
     Rows("18:24").EntireRow.Hidden = True 
     Rows("13:17").EntireRow.Hidden = False 
     Range("B18:B24").Clear 
    End If 

    If Range("B8").Value = "5" Then 
     Rows("19:24").EntireRow.Hidden = True 
     Rows("13:18").EntireRow.Hidden = False 
     Range("B19:B24").Clear 
    End If 

    If Range("B8").Value = "6" Then 
     Rows("20:24").EntireRow.Hidden = True 
     Rows("13:19").EntireRow.Hidden = False 
     Range("B20:B24").Clear 
    End If 

    If Range("B8").Value = "7" Then 
     Rows("21:24").EntireRow.Hidden = True 
     Rows("13:20").EntireRow.Hidden = False 
     Range("B21:B24").Clear 
    End If 

    If Range("B8").Value = "8" Then 
     Rows("22:24").EntireRow.Hidden = True 
     Rows("13:21").EntireRow.Hidden = False 
     Range("B22:B24").Clear 
    End If 

    If Range("B8").Value = "9" Then 
     Rows("23:24").EntireRow.Hidden = True 
     Rows("13:22").EntireRow.Hidden = False 
     Range("B23:B24").Clear 
    End If 

    If Range("B8").Value = "10" Then 
     Rows("24").EntireRow.Hidden = True 
     Rows("13:23").EntireRow.Hidden = False 
     Range("B24").Clear 
    End If 

    If Range("B8").Value = "11" Then 
     Rows("13:24").EntireRow.Hidden = False 
    End If 

    'Now that the original change event has completed, allow future change evnets 
    booCancelChange = False 
End If 



End Sub 

Answer 3

チャンスは自動計算があなたを減速されています。遅い機能では、常にオフにすることをお勧めします。

Private Sub Worksheet_Change(ByVal Target As Range) 

    Application.Calculation=xlCalculationManual 
    Application.EnableEvents = False 

.... 

    Application.Calculation=xlCalculationAutomatic 
    Application.EnableEvents = True 


End Sub