excel private sub worksheet_change无法正常工作

时间:2016-06-16 12:51:46

标签: excel vba excel-vba date

我的Excel工作表中有一个VBA子应该在给定列中查找更改,如果它看到一个,则将日期和时间(从Now())添加到另一列中的相应单元格。此子检查在两个位置进行更改,并根据更改的范围更新不同的单元格(如果列G更改,则更新列A;如果列K更改,则更新列M)。

我没有收到任何错误或任何错误,日期和时间都没有被添加到相应的单元格中。我的代码如下。我不能为我的生活弄清楚它有什么问题。它在几天前工作,从那以后我一直无法工作。

Private Sub Worksheet_Change(ByVal Target As range)

Dim cell As range

'Adds unique keyA values
'Check to see if the changed cell is in column G
    If Not Intersect(Target, range("G:G")) Is Nothing Then
        For Each cell In Target.Cells
            If cell.Value <> vbNullString And Target.Row > 7 And Target.Row <= 20 Then
            'Update the "KeyA" value
                sheets("Front End").range("A" & Target.Row).Value = Now()
            End If
        Next cell
    Else

'Adds unique keyB values
'Check to see if the changed cell is in column K
    If Not Intersect(Target, range("K:K")) Is Nothing Then
        For Each cell In Target.Cells
            If cell.Value <> vbNullString And (Target.Row > "7" And Target.Row <= "27") Then
            'Update the "KeyM" value
                sheets("Front End").range("M" & Target.Row).Value = Now()
            End If
        Next cell
    End If
End If
End Sub

更改行G中值的代码由按钮调用,如下所示:

Private Sub CommandButton1_Click()
Sheets("Front End").Unprotect ("29745")
h = Hour(Now)
    For Each c In range("B8:B20")
        If h = Hour(c) Then
            c.Offset(0, 3) = CInt(c.Offset(0, 3)) + 1
            Exit For
        End If
    Next c
Sheets("Front End").Protect ("29745")
Unload Me
End Sub

1 个答案:

答案 0 :(得分:1)

可能你正试图达到这样的目的:

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim cell As Range

'Adds unique keyA values
'Check to see if the changed cell is in column G
    If Not Intersect(Target, Range("G:G")) Is Nothing Then
        For Each cell In Target.Cells
            If cell.Value <> vbNullString And Target.Row > 7 And Target.Row <= 20 Then
            'Update the "KeyA" value
                Range("A" & Target.Row).Value = Now()
            End If
        Next cell
    Else

'Adds unique keyB values
'Check to see if the changed cell is in column K
    If Not Intersect(Target, Range("K:K")) Is Nothing Then
        For Each cell In Target.Cells
            If cell.Value <> vbNullString And (Target.Row > "6" And Target.Row <= "27") Then
            'Update the "KeyM" value
                Range("M" & Target.Row).Value = Now()
            End If
        Next cell
    End If
End If
End Sub

Worksheet_Change不是Selection_Change。