0

コーディングは初めてですが、ご容赦ください。

ワークブックを開いてワークシートが変更されたときに開始される日付追加のイベント プロシージャを作成しようとしています。

「締め切り」日は、ユーザーが F3:F50 の範囲で手動で入力します。次に、別の日付を範囲 D3:D50 に自動的に挿入して、60 日早くしたいと考えています。

 Private Sub Workbook_Open()
    Sheet1.EventProc1 Sheet1.Range("D3:D50")
End Sub

^^私の理解: 指定された範囲のシート 1 のイベント プロシージャを開始します。

Private Sub Worksheet_Activate()
    EventProc1 Me.Range("D3:D50")
End Sub

^^シートを開いたときと同じことを行います。

Private Sub Worksheet_Change(ByVal Target As Range)
    Application.ScreenUpdating = False
    Application.EnableEvents = False

    EventProc1 Intersect(Target, Me.Range("F3:F50"))

    Application.EnableEvents = True
    Application.ScreenUpdating = True
End Sub

^^ここから混乱が始まります。Intersect F3:F50 は、F3:F50 に新しいデータが入力されたことを検出したときにワークシートの変更を発生させたいと考えて作成しました (これは D3:D50 に影響するはずです)。

Sub EventProc1(rng As Range)
    Dim cell As Range
    Dim Closeout As Date

    If rng Is Nothing Then Exit Sub

    For Each cell In rng.Cells
        Closeout = Range("F3:F50").Value
            Select Case cell
                Case Date: Cells.Value = DateAdd("d", -60, Closeout)
                Case Else: Cells.ClearContents
            End Select
    Next
End Sub

^^メインコードでの私の試み。デバッガーが文字列 "Closeout = Range("F3:F50").Value" の型の不一致エラーを出し始め、初心者のスキルが困惑するまで、部分的に調整して動作させようとしていました。

助言がありますか？これを EventProc として設定した理由は、その上にさらに EventProc を配置するためです。ありがとうございます。

4

1 に答える 1

2

これにより、必要な場所に少し近づくはずです。

  Private Sub Worksheet_Change(ByVal Target As Range)
    'Should probably provide a better check for datatype as well here
    'but your previous code had several cells assigned to the date
        If Intersect(Target, Me.Range("F3:F50")) Is Nothing Then
        Else
        Application.ScreenUpdating = False
        Application.EnableEvents = False

        EventProc1 Target

        Application.EnableEvents = True
        Application.ScreenUpdating = True

        End If
    End Sub


    Sub EventProc1(rng As Range)
        Dim cell As Range
        Dim Closeout As Date
            Closeout = CDate(rng.Value) 
        Cells(4, rng.Column).Value = DateAdd("d", -60, Closeout)

    End Sub

編集：わかりました、いつでもこのイベントを呼び出してください。各セルをロールスルーし、それに応じて毎回更新する必要があります。:-)

Sub NewEventProc1()
    Dim rngCell as Range
    For Each rngCell in Range("F3:F50")
        If TypeName(rngCell) <> "String" Then
             Cells(4, rngCell.Column).Value = DateAdd("d", -60, rngCell.Value)
        End If
    Next
End Sub
于 2013-06-25T00:58:15.973 に答える