1

私は通信会社で働いており、製品のトラブル レポートに関するデータをまとめた Excel ドキュメントでコードを実行しようとしています。

実行したいマクロは、列 (​​月) をクリックすると、各データ セットのリスク スパイダー チャートを生成します。

私が持っているマクロは最初のワークシートでは機能しますが、本質的に同じデータである場合、2 番目のワークシートでは機能しません。

私が得ることができる助けをいただければ幸いです!!

これは私が持っているコードです:

Private Sub Worksheet_Calculate()

    Call UpdateTotalRatings

End Sub

Private Sub Worksheet_Change(ByVal Target As Range)

    If Target.Address = "$B$14" Then
        Call UpdateTotalRatings
    End If
End Sub

Private Sub UpdateTotalRatings()

Dim Cell As Range
Dim LastCol As String

    Application.ScreenUpdating = False

    ' Ensure number of colours is valid (must be 3 or 6).
    If ActiveSheet.Range("B14").Value <> 3 And _
       ActiveSheet.Range("B14").Value <> 6 Then
        ActiveSheet.Range("B14").Value = 3
    End If

    ' Determine right-most column.
     LastCol = Mid(ActiveSheet.Cells.SpecialCells(xlCellTypeLastCell).Address, 2, 1)

    For Each Cell In Range("B13:" & LastCol & "13")
        If IsNumeric(Cell.Value) Then
            Cell.Interior.Color = ThisWorkbook.GetColour(Cell.Value, _
            ActiveSheet.Range("B14").Value)
        End If
    Next
    Application.ScreenUpdating = True

 End Sub
4

2 に答える 2

1

ThisWorkbook モジュールにコードを (いくつかの変更を加えて) 配置すると、ブック内のすべてのシートで機能します。

Private Sub Workbook_SheetCalculate(ByVal Sh As Object)

    UpdateTotalRankings Sh

End Sub

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)

    If Target.Address = "$B$14" Then
        UpdateTotalRankings Sh
    End If

End Sub

Private Sub UpdateTotalRankings(Sh As Object)

    Dim rCell As Range
    Dim lLastCol As Long

    Application.ScreenUpdating = False

    ' Ensure number of colours is valid (must be 3 or 6).
    If Sh.Range("B14").Value <> 3 And _
        Sh.Range("B14").Value <> 6 Then

        Sh.Range("B14").Value = 3
    End If

    ' Determine right-most column.
    lLastCol = Sh.Cells.SpecialCells(xlCellTypeLastCell).Column

    For Each rCell In Sh.Range("B13").Resize(1, lLastCol - 1).Cells
        If IsNumeric(rCell.Value) Then
            rCell.Interior.Color = Me.GetColour(rCell.Value, _
                Sh.Range("B14").Value)
        End If
    Next rCell

    Application.ScreenUpdating = True

End Sub

処理したくないシートがある場合は、Sh 引数を確認できます。多分それはシート名に基づいています

If Sh.Name Like "Report_*" Then

名前が Report_ で始まるシートのみを処理します。または

If Sh.Range("A14").Value = "Input" Then

処理するシートを識別する特定の値を持つセル (A14 など) をチェックします。

于 2012-07-10T15:52:48.230 に答える
0

このプロシージャWorksheet_Changeはイベント プロシージャです。

対応するワークシートモジュールにのみ存在することが想定されています（また、存在することもできます）。そのため、コードが他のシートでは機能しません。

それを機能させるには、次のことが必要です。

  • VBA で何をしようとしているのかを理解する
  • これが必要なすべてのワークシート モジュールでイベント プロシージャを呼び出す
  • 「コード」標準モジュールに保存するメイン プロシージャを使用します (ここでは正しい名前を思い出せません)。
  • 範囲引数を使用してTarget、プロシージャ (または少なくとも適切なワークシート) をメイン プロシージャに渡します。

- - - 編集 - - - -

まず、変更

Private Sub UpdateTotalRatings()

に

Sub UpdateTotalRatings(Optional ByVal Target As Range)

次に、すべてSub UpdateTotalRatings(Optional ByVal Target As Range)をモジュールに移動します

そして、すべてのワークシート モジュールに以下を追加します。

Private Sub Worksheet_Calculate()

    Call UpdateTotalRatings

End Sub

Private Sub Worksheet_Change(ByVal Target As Range)

    If Target.Address = "$B$14" Then
        Call UpdateTotalRatings(Target)
    End If
End Sub
于 2012-06-21T14:59:11.467 に答える